Amiga Collections: Franz PD/Franz PD Disk #110 (1991-01)(Amiga User Group Deutschland e.V.).zip/Franz PD Disk #110 (1991-01)(Amiga User Group Deutschland e.V.).adf/Comic_Verwaltung/comic.haupt

AmigaBASIC Source Code | 1989-07-03 | 67KB | 2,891 lines

CLEAR,100000
 ' (c) Andreas Zottmann
anfang:
DEFINT a-z
true=-1:false=0
maxint=32767
ersterDruck=true
DIM muster(3)
DECLARE FUNCTION Execute& LIBRARY
DECLARE FUNCTION xOpen&  LIBRARY
ig=0:cr$=CHR$(13):va=0:voraend=0:au=0:fehler=0:Pfad$="comp/":weg$="comdat/"
GOSUB initialisierung
GOSUB werteladen:aa=an: REM alte anzahl
DIM um(97),dec(83),cod(43)
FOR i=0 TO 97:READ q$:um(i)=VAL("&h"+q$):NEXT i
FOR i=0 TO 43:READ q$:cod(i)=VAL("&h"+q$):NEXT i
FOR i=0 TO 83:READ q$:dec(i)=VAL("&h"+q$):NEXT i
FOR i=0 TO zmax-1:zust$(i)=RIGHT$(STR$(i),LEN(STR$(i))-1):NEXT i
i=an\2+1
MENU 1,0,1,"Project"
MENU 1,1,1,"Eingabe"
MENU 1,2,1,"neue Titel"
MENU 1,3,1,"Bereiche sperren"
MENU 1,4,1,"Datei erweitern"
MENU 1,5,1,"Datei löschen"
MENU 1,6,0,"             "
MENU 1,7,1,"Programm beenden"
MENU 2,0,1," Auswertung "
MENU 2,1,1,"Vorhandene Hefte"
MENU 2,2,1,"Fehlende Hefte"
MENU 2,3,1,"Mehrfache"
MENU 2,4,1,"Suchen"
MENU 2,5,1,"Löschen"
MENU 2,6,1,"Auswertung nach Zustand"
MENU 2,7,1,"Ausdruck"
MENU 3,0,1," Extras "
MENU 3,1,1,"neue Auswertung"
MENU 3,2,1,"Druckereinstellung"
MENU 3,3,1,"Datensicherung"
MENU 3,4,1,"Datenrekonstruktion"
MENU 3,5,1,"Pfadwechsel"
MENU 4,0,0,""
IF an=0 THEN
  MENU 1,1,0:MENU 1,3,0:MENU 1,4,0:MENU 1,5,0
  MENU 2,0,0
  MENU 3,1,0
  MENU 3,3,0
END IF
haupt:
  dg=an:au=0
  CLS
  LOCATE 3,12:PRINT "           C o m i c - V e r w a l t u n g"
  LOCATE 7,30:PRINT "von Andreas Zottmann"
  LOCATE 12,34:PRINT "1.Project"
  LOCATE 14,34:PRINT "2.Auswertung"
  LOCATE 16,34:PRINT "3.Extras"
  LOCATE 18,34:PRINT "4.Programm beenden"
  q=0
  WHILE q<1 OR q>4 OR (an=0 AND q=2)
    taste q:q=q-ASC("0")
    IF men0>0 THEN q=men1:ON men0 GOTO projvert,auswvert,extvert
  WEND
 ON q GOTO project,auswertung,extras,abmelden
project:
CLS
LOCATE 5,34:PRINT "1. Eingabe"
LOCATE 7,34:PRINT "2. neue Titel"
LOCATE 9,34:PRINT "3. Bereiche sperren"
LOCATE 11,34:PRINT "4. Datei erweitern"
LOCATE 13,34:PRINT "5. Datei löschen"
LOCATE 15,34:PRINT "6. Hauptmenü"
q=0
WHILE q<1 OR q>6 OR(an=0 AND q<>2 AND q<>6)
  taste q
  IF q=129 THEN haupt
  q=q-ASC("0")
WEND
projvert:
  ON q GOTO eingabe,neuetitel,bereichesperren,dateierweitern,dateiloeschen,haupt,abmelden

eingabe:n$="":nn$=CHR$(0):ver=true:IF i>an OR i<1 THEN i=an\2+1
CLS:LOCATE 1,33:PRINT "E i n g a b e"
LINE (12,11)-(72,43),2,bf
LINE (11,10)-(73,44),3,b
LINE (12,27)-(72,27),3
LINE (42,11)-(42,44),3
LINE (26,16)-(26,23),3
LINE (26,31)-(26,38),3
LINE (57,17)-(57,24),3
LINE (57,30)-(57,37),3
LINE (26,15)-(30,19),3
LINE (26,15)-(22,19),3
LINE (26,39)-(30,35),3
LINE (26,39)-(22,35),3
LINE (57,16)-(61,20),3
LINE (57,16)-(53,20),3
LINE (57,13)-(61,17),3
LINE (57,13)-(52,17),3
LINE (57,38)-(61,34),3
LINE (57,38)-(53,34),3
LINE (57,41)-(61,37),3
LINE (57,41)-(53,37),3

namelesen:xakt=1
LOCATE 4,12:PRINT "Name :   "+SPACE$(30):LOCATE 4,21:PRINT n$
q=0:nurCr=true
WHILE q<>13
310
taste q
IF q=129 THEN CLOSE 1:GOTO haupt
  IF mausx>11 AND mausx<73 AND mausy>10 AND mausy<44 THEN
    IF mausx<42 AND mausy<27 THEN
      i=i-1
    ELSEIF mausy<27 AND an>10 THEN
      i=i-10
    ELSEIF mausx>42 AND an>10 THEN
      i=i+10
    ELSEIF mausx<42 THEN
      i=i+1
    ELSE
      GOTO 310
    END IF
    IF i<1 THEN i=an+i :ELSE IF i>an THEN i=i-an
    n$=t$(in(i)):nn$=n$
    ver=true:nurCr=true
    GOTO namelesen
  ELSEIF q=28 OR q=29 THEN
    IF q=29 THEN i=i+1 :ELSE i=i-1
    IF i<1 THEN i=an+i :ELSE IF i>an THEN i=i-an
    n$=t$(in(i)):nn$=n$
    ver=true:nurCr=true
    GOTO namelesen
  ELSEIF q<>13 AND mausx<0 THEN
    IF q=31 AND xakt>1 THEN
      xakt=xakt-1
    ELSEIF q=30 AND xakt<=LEN(n$) THEN
      xakt=xakt+1
    ELSEIF q=8 AND  n$<>"" AND xakt>1 THEN
      n$=LEFT$(n$,xakt-2)+RIGHT$(n$,LEN(n$)-xakt+1):xakt=xakt-1:l$=" "
      nurCr=false
    ELSEIF q=127 AND n$<>"" AND xakt<= LEN(n$) THEN
      n$=LEFT$(n$,xakt-1)+RIGHT$(n$,LEN(n$)-xakt):l$=" "
      nurCr=false
    ELSEIF q=8 OR q=127 OR LEN(n$)=30 OR q=31 OR q=30 THEN
      GOTO 320
    ELSE
      n$=LEFT$(n$,xakt-1)+CHR$(q)+RIGHT$(n$,LEN(n$)-xakt+1)
      xakt=xakt+1
      nurCr=false
    END IF
    ver=true
    LOCATE 4,21:PRINT LEFT$(n$,xakt-1);
    COLOR 2
    PRINT MID$(n$,xakt,1);
    COLOR 1
    IF xakt<LEN(n$) THEN PRINT RIGHT$(n$,LEN(n$)-xakt);
    PRINT l$;:l$=""
    320
  END IF
WEND
IF ver THEN CLOSE 1
IF NOT(nurCr) THEN
  n$=LEFT$(n$,xakt-1)
  LOCATE 4,21+LEN(n$):PRINT SPACE$(30-LEN(n$))
END IF
IF n$="" THEN namelesen
IF n$<>nn$ THEN
  q$=n$:GOSUB suche
  IF i<1 THEN
    nn$=CHR$(0)
    LOCATE 18,21:PRINT "Titel nicht vorhanden"
    LOCATE 19,25:PRINT "(1. Namen ändern)"
    LOCATE 20,25:PRINT "(2. neuen Namen aufnehmen)"
    q=0
    WHILE q<1 OR q>2
      taste q
      IF q=129 THEN CLOSE 1:GOTO haupt
      q=q-ASC("0")
    WEND
    LOCATE 18,21:PRINT SPACE$(21)
    LOCATE 19,25:PRINT SPACE$(17)
    LOCATE 20,25:PRINT SPACE$(26)
    IF q=2 THEN project :ELSE i=(o+u)\2:GOTO namelesen
  ELSE
    n$=t$(in(i))
  END IF
END IF
index=in(i)
IF ver THEN
  oeffne weg$+t$(index),1,satzl,0
  FIELD 1,satzl AS d$
  IF j(index)=-1 THEN LOCATE 6,12:PRINT SPACE$(20)
  laenge=LOF(1)/satzl
  ver=false
END IF
IF j(index)=-1 THEN
  o=1
ELSE
  j$=RIGHT$(j$,2)
410
  LOCATE 6,12:PRINT "Jahrgang (jj)   ";:lies j$,4
  IF ASC(j$+" ")=129 THEN CLOSE 1:GOTO haupt
  IF (VAL(j$)=0 AND INSTR("00",j$)=0) OR VAL(j$)>99 OR VAL(j$)<0 OR INT(VAL(j$))< VAL(j$) OR j$="" THEN 410
  IF VAL(j$)<j(index) THEN j$=STR$(100+VAL(j$))
  o=0
END IF
nr=0
WHILE nr<1 OR (o=0 AND nr>maxnr(index))
  nr$="":LOCATE 8,19:PRINT SPACE$(10)
  LOCATE 8,12:INPUT "Nummer ", nr$
  IF ASC(nr$+" ")=129 THEN CLOSE 1:GOTO haupt
  IF LEN(nr$)<6 THEN
    long&=VAL(nr$)
    IF long&<=maxint THEN nr=long&
  END IF
WEND
IF zmax=1 THEN
  z=0
ELSE
  z$=""
  WHILE z$<"0" OR z$>zmax$ OR LEN(z$)>1
    LOCATE 10,12:PRINT "Zustand (0-"zmax$") ";:INPUT "",z$
    IF ASC(z$+" ")=129 THEN CLOSE 1:GOTO haupt
  WEND
  z=VAL(z$)
END IF
an$=""
WHILE VAL(an$)<1 OR VAL(an$)>5
  an$="1":LOCATE 12,12:PRINT "Anzahl  ";:lies an$,2
  IF ASC(an$+" ")=129 THEN CLOSE 1:GOTO haupt
WEND
IF o=1 THEN
  l=nr
ELSE
  l=maxnr(index)*(VAL(j$)-j(index))+nr
END IF
IF l> laenge THEN CLOSE 1:GOTO 4570
GET 1,l
decodiere d$
IF dat(0)>0 THEN
  FOR j=0 TO zmax:dat(j)=0:NEXT j
  z(zmax,index)=z(zmax,index)+1
END IF
IF geszahl>0 THEN z(zmax+1,index)=z(zmax+1,index)+VAL(an$) :ELSE IF VAL(an$)>1 THEN z(zmax+1,index)=z(zmax+1,index)+VAL(an$)-1
dat(z+1)=dat(z+1)+VAL(an$):codiere q$
LSET d$=q$:PUT 1,l
z(z,index)=z(z,index)+VAL(an$)
dr(index)=dr(index) OR 4:dr(0)=dr(0)OR 4
LOCATE 20,24:PRINT "weiter (Cr) oder Ende (F10)"
q=0
WHILE q<>13 AND q<>138 AND q<>129
  taste q
WEND
IF q=138 OR q=129 THEN CLOSE 1:GOTO haupt
nn$=n$:LOCATE 20,24:PRINT SPACE$(27):GOTO namelesen

auswertung:
CLS
LOCATE 3,25:PRINT "      A u s w e r t u n g"
LOCATE 5,25:PRINT "1.Auflisten vorhandener Hefte"
LOCATE 7,25:PRINT "2.Auflisten fehlender Hefte"
LOCATE 9,25:PRINT "3.Auflisten von Mehrfachen"
LOCATE 11,25:PRINT "4.Suchen"
LOCATE 13,25:PRINT "5.Löschen"
LOCATE 15,25:PRINT "6.Auswertung nach Zustand"
LOCATE 17,25:PRINT "7.Ausdruck"
LOCATE 19,25:PRINT "8.Hauptmenü"
q=0
WHILE q<1 OR q>8
  taste q
  IF q=129 THEN haupt
  q=q-ASC("0")
WEND
auswvert:
ON q GOTO auflisten,fehlende,auflisten,heftsuchen,heftloeschen,zustand,ausdruck,haupt
auflisten:
wahl=(q+1)/2:GOSUB 4650
gz=0:stw=0
oeffne (weg$+t$(index)),1,satzl,0:r=1
FIELD 1,satzl AS d$
laenge=LOF(1)/satzl
l=1
titelleiste 1
WHILE l<=laenge
  GET 1,l
  decodiere d$
  IF dat(0)=0 AND geszahl>wahl-1 THEN
    jahreszahl l,j,nr
    r=r+2:gz=gz+geszahl:IF wahl=2 THEN gz=gz-1
    IF r>21 THEN
 1100 taste q:IF men0>0 THEN 1100
      IF q=129 THEN GOSUB startwert:titelleiste 1:GOTO 1160
      CLS:titelleiste 1:r=3
    END IF
    LOCATE r,1:PRINT t$(index)
    LOCATE r,31:IF j(index)>-1 THEN PRINT USING"#### ";j;
    PRINT USING "#####";nr;
    PRINT SPACE$(bestZust*3);
    FOR j=bestZust+1 TO zmax:
      IF dat(j)>0 THEN PRINT  USING "###";dat(j); :ELSE PRINT "   ";
    NEXT:PRINT USING "######";geszahl;
  END IF
  l=l+1
  IF ASC(INKEY$+" ")=129 THEN GOSUB startwert:titelleiste 1
1160
WEND
CLOSE 1
LOCATE 23,5:PRINT "Taste";:taste q
IF stw=0 THEN
  CLS
  LOCATE 10,29
  IF gz=1 THEN PRINT "Es ist insgesamt " :ELSE PRINT "Es sind"
  LOCATE 12,34:IF gz=1 THEN PRINT "ein" :ELSE PRINT gz
  LOCATE 14,34:IF wahl=1 THEN PRINT "Heft"; :ELSE PRINT "Mehrfache";
  IF gz<>1 AND wahl=1 THEN PRINT "e"
  IF gz=1 AND wahl=2 THEN PRINT "s"
  LOCATE 16,30:PRINT " vorhanden."
  LOCATE 20,5:PRINT "Taste"
  taste q
END IF
GOTO haupt
startwert:
CLS
LOCATE 22,10:PRINT "CR: Anfangswert für das Auflisten ändern    F10: Hauptmenü"
q=0
WHILE q<>13 AND q<>138 AND q<>129
  taste q
WEND
IF q=138 OR q=129 THEN CLOSE 1:RETURN haupt
stw=1
LOCATE 5,5:PRINT "Anfangswert"
jahreszahl laenge,j,nr
IF j(index)>-1 THEN
  q$=STR$(j(index)):q$=RIGHT$(q$,LEN(q$)-1)
  LOCATE 6,7:PRINT "Jahrgang ";j(index);" -";j
st1: LOCATE 6,26:lies q$,4
  j=VAL(q$)
  IF (j=0 AND INSTR("00",q$)=0) OR j>99 OR j<0 OR q$="" THEN st1
  IF j<j(index) THEN j=j+100
  IF (j-j(index))*maxnr(index)>laenge THEN st1
END IF
q$="1":LOCATE 8,7:PRINT "Nummer "
st2: LOCATE 8,15:lies q$,5
 long&=VAL(q$)
 IF long&>maxint THEN st2 :ELSE nr=long&
IF nr<1 OR nr>laenge THEN st2
IF j(index)>-1 AND(nr>maxnr(index) OR (j-j(index))*maxnr(index)+nr>laenge) THEN st2
IF j(index)>-1 THEN
  l=(j-j(index))*maxnr(index)+nr
ELSE
  l=nr
END IF
CLS:r=1
RETURN
fehlende:
GOSUB 4650
oeffne (weg$+t$(index)),1,satzl,0:r=1
FIELD 1,satzl AS d$
laenge=LOF(1)/satzl
l=1
titelleiste 2
WHILE l<=laenge
  GET 1,l
  decodiere d$
  IF dat(0)=0 AND geszahl=0 THEN
    jahreszahl l,j,nr
    r=r+2
    IF r>21 THEN
 1450 taste q:IF men0>0 THEN 1450
      IF q=129 THEN GOSUB startwert:titelleiste 2:GOTO 1510
      CLS:titelleiste 2:r=3
    END IF
    LOCATE r,1:PRINT t$(index)
    IF j(index)>=0 THEN LOCATE r,32:PRINT USING"###"; j
    LOCATE r,36:PRINT USING"######";nr
  END IF
  l=l+1
  IF ASC(INKEY$+" ")=129 THEN GOSUB startwert:titelleiste 2
1510
WEND
CLOSE 1
LOCATE 23,5:PRINT "Taste";
taste q
GOTO haupt
heftsuchen:
GOSUB 4650:o=0
CLS
IF j(index)>-1 THEN
  j$=""
  WHILE LEN (j$)>2 OR (VAL(j$)=0 AND INSTR("00",j$)=0) OR j$=""
    LOCATE 7,14:PRINT "Jahrgang (jj) ";:INPUT "",j$
    IF ASC(j$+" ")=129 THEN haupt
  WEND
  IF VAL(j$)<j(index) THEN j$=STR$(100+VAL(j$))
  o=0
ELSE
  o=1
END IF
nr$="":nr=0
WHILE nr<1 OR (o=0 AND nr>maxnr(index))
  LOCATE 9,14:PRINT "Nummer  ";:INPUT "",nr$
  IF ASC(nr$+" ")=129 THEN haupt
  IF LEN(nr$)<6 THEN
    long&=VAL(nr$)
    IF long&<=maxint THEN nr=long&
  END IF
WEND
IF o=1 THEN l=nr:j$="" :ELSE l=maxnr(index)*(VAL(j$)-j(index))+nr
oeffne (weg$+t$(index)),1,satzl,0
FIELD 1,satzl AS d$
laenge=LOF(1)/satzl
IF l>laenge THEN
  GOSUB 2160
ELSE
  GET 1,l
  decodiere d$
  IF dat(0)>0 THEN
    GOSUB 2160
  ELSE
    CLS:LOCATE 4,9:PRINT t$(index)
    IF o=0 THEN LOCATE 8,14: PRINT  "Jahrgang " ;RIGHT$(j$,2)
    LOCATE 10,14:PRINT  "Nummer    "; nr$
    schreibezustaende
  END IF
END IF
CLOSE 1
LOCATE 22,14:PRINT "weiter (Cr) oder Ende (F10)"
q=0
WHILE q<>13 AND q<>138 AND q<>129
  taste q
WEND
IF q=13 THEN heftsuchen
GOTO haupt
2160
 CLS
 LOCATE 4,9:PRINT  t$(index)
 LOCATE 9,19:PRINT RIGHT$(j$,2)
 LOCATE 9,26:PRINT nr$
 LOCATE 14,24:PRINT "existiert nicht "
RETURN
heftloeschen:
GOSUB 4650
CLS
IF j(index)>-1 THEN
  j$=""
  WHILE (VAL(j$)=0 AND INSTR("00",j$)=0) OR j$=""
    LOCATE 7,14:PRINT "Jahrgang (jj)  ";:lies j$,2
    IF ASC(j$+" ")=129 THEN haupt
  WEND
  IF VAL(j$)<j(index)THEN j$=STR$(100+VAL(j$))
  o=0
ELSE
  o=1
END IF
nr$="":nr=0
WHILE nr<1
  LOCATE 9,14:PRINT "Nummer  ";:INPUT "",nr$
  IF ASC(nr$+" ")=129 THEN haupt
  IF LEN(nr$)<6 THEN
    long&=VAL(nr$)
    IF long&<=maxint THEN nr=long&
  END IF
WEND
IF o=1 THEN l=nr :ELSE l=maxnr(index)*(VAL(j$)-j(index))+nr
oeffne (weg$+t$(index)),1,satzl,0
FIELD 1,satzl AS d$
laenge=LOF(1)/satzl
IF l>laenge THEN
  GOSUB 2610
ELSE
  GET 1,l
  decodiere d$
  IF dat(0)>0 THEN
    GOSUB 2610
  ELSEIF geszahl=0 THEN
    LOCATE 22,14:PRINT "Bestand gleich Null"
    taste q
  ELSE
    schreibezustaende
    IF geszahl=1 OR zmax=1 THEN
      zust=bestZust
      io=1
      GOSUB 2615
    ELSE
      LOCATE 16,14:PRINT "Zustand :"
      q=-1
      WHILE q<0 OR q>zmax-1
        taste q
        IF q=129 THEN CLOSE 1:GOTO haupt
        q=q-ASC("0")
      WEND
      IF dat(q+1)=0 THEN
        GOSUB 2610
      ELSEIF dat(q+1)=1 THEN
        zust=q:io=1
        GOSUB 2615
        IF q=13 THEN z(zmax+1,index)=z(zmax+1,index)-1
      ELSE
        LOCATE 17,14:PRINT "Wieviele Hefte(1 -";dat(q+1);")"
        az$=""
        WHILE VAL (az$)<1 OR VAL(az$)>dat(q+1)OR VAL(az$)<>INT(VAL(az$))
          LOCATE 17,36:INPUT "",az$
          IF ASC(az$+" ")=129 THEN CLOSE 1:GOTO haupt
        WEND
        io=VAL(az$):zust=q
        GOSUB 2615
        IF q=13 THEN
          IF VAL(az$)=geszahl THEN
            z(zmax+1,index)=z(zmax+1,index)-geszahl+1
          ELSE
            z(zmax+1,index)=z(zmax+1,index)-VAL(az$)
          END IF
        END IF
      END IF
    END IF
  END IF
END IF
CLOSE 1:GOTO haupt
2610
 LOCATE 18,14:PRINT "Heft nicht vorhanden (Taste )"
 taste q
RETURN
2615
 LOCATE 18,14:PRINT "cr: löschen, f10: Hauptmenü"
 q=0
 WHILE q<>13 AND q<>138 AND q<>129
   taste q
 WEND
 IF q=13 THEN
   dat(zust+1)=dat(zust+1)-io
   codiere q$
   LSET d$=q$:PUT 1,l
   dr(0)=dr(0)OR 4:dr(index)=dr(index)OR 4
   z(zust,index)=z(zust,index)-io
 END IF
RETURN
zustand:
CLS:au=0
LOCATE 4,26:PRINT "Auswertung nach Zustand"
LOCATE 7,26:PRINT "1.Auswertung einer Sorte"
LINE (194,44)-(398,60),1,b
LOCATE 10,26:PRINT "2.Auswertung einer Auswahl"
LINE (194,68)-(414,84),1,b
LOCATE 13,26:PRINT "3.Gesamtauswertung"
LINE (194,92)-(350,108),1,b
q=0
WHILE q<1 OR q>3
  taste q
  IF q=129 THEN haupt
  q=q-ASC("0")
  IF mausx>194 THEN
    IF mausx<399 AND mausy>43 AND mausy<61 THEN
      q=1
    ELSEIF mausx<415 AND mausy>67 AND mausy<85 THEN
      q=2
    ELSEIF mausx<351 AND mausy>91 AND mausy<109 THEN
      q=3
    END IF
  END IF
WEND
o=0
IF q=1 THEN
  GOSUB 4650
  anzahl=0
  FOR j=0 TO zmax-1
    a(j)=z(j,index)
    anzahl=anzahl+a(j)
  NEXT j
  gesamt=z(zmax,index):doppelt=z(zmax+1,index)
  fehlend=gesamt-anzahl+doppelt
  q$=t$(index)
ELSE
  IF q=2 THEN GOSUB 8580
  IF au=2 THEN GOSUB 4650
  FOR j=0 TO zmax-1:a(j)=0:NEXT j:gesamt=0:doppelt=0:anzahl=0
  CLS:LOCATE 5,5:PRINT "Auswertung läuft"
  FOR i=1 TO an
    IF au=0 OR ((dr(i)AND 1)>0) THEN
      FOR j=0 TO zmax-1:a(j)=a(j)+z(j,i):NEXT j:gesamt=gesamt+z(zmax,i):doppelt=doppelt+z(zmax+1,i)
    END IF
  NEXT i
  FOR j=0 TO zmax-1:anzahl=anzahl+a(j):NEXT:fehlend=gesamt-anzahl+doppelt
  IF au>0 THEN q$="Auswahl" :ELSE q$="Gesamtauswertung"
END IF
CLS:GOSUB 6000:au=0
IF gesamt=0 THEN taste q:GOTO haupt
LOCATE 20,5:PRINT "CR : graphische Auswertung   F10 : Hauptmenü"
q=0
WHILE q<>13 AND q<>138 AND q<>129
  taste q
WEND
IF q=138 OR q=129 THEN haupt
CLS
LOCATE 1,1:PRINT "Zustand"
IF anzahl>0 THEN
  maximum=0
  FOR j=0 TO zmax-1
    IF a(j)>maximum THEN maximum=a(j)
  NEXT j
  LOCATE 2,1:PRINT USING"###%";100*maximum/anzahl
  LOCATE 7,1:PRINT USING"###%";100*maximum/anzahl*0.75
  LOCATE 12,1:PRINT USING"###%";100*maximum/anzahl*0.5
  LOCATE 17,1:PRINT USING"###%";100*maximum/anzahl*0.25
  breite=(400-(zmax-1)*5)\zmax
  hoehe=150
  FOR j=0 TO zmax-1
    x=30+j*(breite+5)
    y=INT(12+hoehe*(1-(a(j)/maximum)))
    ON j+1 GOSUB mus1,mus2,mus3,mus4,mus5,mus6,mus7,mus8,mus9,mus10
    PATTERN ,muster
    LINE (x,12+hoehe)-(x+breite,y),j MOD 3+1,bf
    LOCATE 22,x\8+2:PRINT USING"###%";a(j)/anzahl*100;
  NEXT j
  GOSUB mus11:PATTERN ,muster
END IF
LOCATE 1,57:PRINT "Anzahl"
y=INT(12+hoehe*(1-(gesamt-fehlend)/gesamt))
LINE (450,12+hoehe)-(510,12),,b
LINE (450,12+hoehe)-(510,y),1,bf
LOCATE 22,57:PRINT  USING "###.##%";100*(gesamt-fehlend)/gesamt;
IF anzahl>0 THEN
  LOCATE 1,66:PRINT "Doppelte"
  y=INT(12+hoehe*(1-doppelt/anzahl))
  LINE (520,12+hoehe)-(580,12),,b
  LINE (520,12+hoehe)-(580,y),,bf
  LOCATE 22,66:PRINT USING "###.##%";100*doppelt/anzahl;
END IF
LOCATE 23,1:PRINT "Taste";:taste q:GOTO haupt
REM muster
mus1:
muster(0)=&H8888
muster(1)=&H4444
muster(2)=&H2222
muster(3)=&H1111
RETURN
mus2:
muster(3)=&H8888
muster(2)=&H4444
muster(1)=&H2222
muster(0)=&H1111
RETURN
mus3:
muster(0)=&Hcccc
muster(1)=&H6666
muster(2)=&H3333
muster(3)=&H9999
RETURN
mus4:
muster(0)=&Hffff
muster(1)=&H9999
muster(2)=&H9999
muster(3)=&Hffff
RETURN
mus5:
muster(0)=INT(32767-65536*RND)
muster(1)=INT(32767-65536*RND)
muster(2)=INT(32767-65536*RND)
muster(3)=INT(32767-65536*RND)
RETURN
mus6:
muster(0)=&H8888
muster(1)=&Hc183
muster(2)=&Hc183
muster(3)=&H1111
RETURN
mus7:
muster(0)=&H8181
muster(1)=&H4242
muster(2)=&H2424
muster(3)=&H1818
RETURN
mus8:
muster(0)=&Hcccc
muster(1)=&H3333
muster(2)=&Hcccc
muster(3)=&H3333
RETURN
mus9:
muster(0)=&H3c0
muster(1)=&Hc30
muster(2)=&H300c
muster(3)=&Hc003
RETURN
mus10:
muster(0)=&Hffff
muster(1)=&H101
muster(2)=&Hffff
muster(3)=&H101
RETURN
mus11:
muster(0)=&Hffff
muster(1)=&Hffff
muster(2)=&Hffff
muster(3)=&Hffff
RETURN

extras:
CLS
LOCATE 3,25:PRINT "       E x t r a s      "
LOCATE 5,25:PRINT "1. neue Auswertung"
LOCATE 7,25:PRINT "2. Druckereinstellung"
LOCATE 9,25:PRINT "3. Datensicherung"
LOCATE 11,25:PRINT "4. Datenrekonstruktion"
LOCATE 13,25:PRINT "5. Pfadwechsel"
LOCATE 15,25:PRINT "6. Hauptmenü"
q=0
WHILE q<1 OR q>6 OR(an=0 AND (q=1 OR q=3))
  taste q
  IF q=129 THEN haupt
  q=q-ASC("0")
WEND
extvert:
ON q GOTO neueausw,druckereinst,datensich,datenrek,pfadwechsel,haupt
neuetitel:
CLS
IF an = mq THEN
  LOCATE 20,4:PRINT "Es ist kein Platz mehr frei.Bitte erst abmelden (Punkt 4 im Haupt-"
  LOCATE 21,4:PRINT "menü), dann Programm neu starten."
  LOCATE 23,10:PRINT "(Taste)";:taste q
  GOTO haupt
END IF
tt$=""
3005
LOCATE 7,17:PRINT "Titel : ";:lies tt$,30
IF ASC(tt$+" ")=129 THEN haupt
IF LEN(tt$)<1 OR INSTR(tt$,":")>0 OR INSTR(tt$,"/")>0 OR INSTR(tt$,"#?")>0 THEN 3005
q$=tt$:GOSUB suche
IF i>-1 THEN
  LOCATE 22,9:PRINT "Titel ist schon vorhanden (Taste)"
  taste q
  IF q=129 THEN haupt
  CLS:GOTO 3005
END IF
fehler=0
ON ERROR GOTO fehlerausw
OPEN weg$+tt$ AS 1 LEN=satzl
IF fehler=61 THEN
  CLOSE 1
  LOCATE 22,9:PRINT "Die Diskette ist voll. Bitte zuerst eine neue anlegen, dann weitermachen (Taste)."
  taste q
  fehler=0
  GOTO haupt
END IF
IF fehler=74 THEN CLOSE 1:GOTO 3005
ON ERROR GOTO 0
FIELD 1,satzl AS d$
umlaut q$
FOR i=an TO 1 STEP -1
  q2$=t$(in(i)):umlaut q2$
  IF q2$>q$ THEN in(i+1)=in(i) :ELSE IF q$>q2$ THEN in(i+1)=an+1:GOTO 3105
  IF q$=q2$ THEN
    IF t$(in(i))> tt$ THEN in(i+1)=in(i) :ELSE in(i+1)=an+1:GOTO 3105
  END IF
NEXT i
in(1)=an+1
3105
t$(an+1)=tt$
l=0:jj$=""
WHILE VAL(jj$)<0 OR (VAL(jj$)=0 AND INSTR("00",jj$)=0 AND jj$<>".")OR jj$=""
  LOCATE 9,17:PRINT "Anfangsjahr (.=Nummern)";:lies jj$,2
WEND
IF jj$="." THEN
  j(an+1)=-1:maxnr(an+1)=0
ELSE
  j(an+1)=VAL(jj$)
  ej$=""
  WHILE VAL(ej$) < 0 OR (VAL(ej$)=0 AND INSTR("00",ej$)=0)OR ej$="" OR LEN(ej$)>2
    LOCATE 11,17:PRINT "Endjahr ";:ej$=jj$:lies ej$,4
  WEND
  l=VAL(ej$)-VAL(jj$):IF l<0 THEN l=l+100
  LOCATE 13,17:PRINT "Höchste Heftnummer im Jahr : ";:maxnum$="53"
  maxnum=0
  WHILE maxnum<1 OR maxnum>366
    LOCATE 13,45:lies maxnum$,5
    long&=VAL(maxnum$)
    IF long&<=maxint THEN maxnum=long&
  WEND
  maxnr(an+1)=maxnum
  l=maxnr(an+1)*l
END IF
q$=""
WHILE VAL(q$)<1 OR VAL(q$)<>INT(VAL(q$)) OR (j(an+1)>-1 AND VAL(q$)>maxnr(an+1)) OR VAL(q$)>maxint
  LOCATE 15,17:PRINT "Endnummer  ";:lies q$,5
WEND
q=l+VAL(q$):z(zmax,an+1)=q
FOR j=0 TO zmax-1
  z(j,an+1)=0
NEXT j
z(zmax+1,an+1)=0:dr(0)=dr(0)OR 4:dr(an+1)=4
LOCATE 17,17:PRINT "Voreinstellung Ausdruck (j/n): "
rq$=""
WHILE rq$<>"J" AND rq$<>"N"
  rq$=UCASE$(INKEY$)
WEND
IF rq$="J" THEN dr(an+1)=dr(an+1)OR 1
fehler=0
ON ERROR GOTO fehlerausw
LSET d$=STRING$(satzl,0)
FOR x=1 TO q:LOCATE 19,29:PRINT x
PUT 1,x
IF fehler=61 THEN
  z(zmax,an+1)=x-1
  LOCATE 22,9:PRINT "Die Diskette ist voll."
  taste q
  fehler=0
  GOTO 3210
END IF
NEXT x
3210
CLOSE 1
IF an=0 THEN
  MENU 1,1,1:MENU 1,3,1:MENU 1,4,1:MENU 1,5,1
  MENU 2,0,1
  MENU 3,1,1
  MENU 3,3,1
END IF
an=an+1
ON ERROR GOTO 0
IF LEN(tt$)<30 THEN KILL weg$+tt$+".info"
LOCATE 22,14:PRINT "Weiter (Cr) oder Ende (F10)"
q=0
WHILE q<>13 AND q<>138 AND q<>129
  taste q
WEND
IF q=13 THEN neuetitel :ELSE i=i+1:GOTO haupt
bereichesperren:
GOSUB 4650
o=0
IF j(index)=-1 THEN
  o=1
ELSE
  q$=""
  WHILE (jj=0 AND INSTR("00",q$)=0)OR jj<0 OR jj>99 OR q$=""
    LOCATE 4,14:PRINT "Jahrgang ";:lies q$,2
    IF ASC(q$+" ")=129 THEN haupt
    jj=VAL(q$)
  WEND
  IF jj<j(index) THEN jj=jj+100
END IF
q$="":nn=0
WHILE nn<1
  LOCATE 6,14:PRINT "Anfangsnummer ";:lies q$,5
  IF ASC(q$+" ")=129 THEN haupt
  long&=VAL(q$)
  IF long&<=maxint THEN nn=long&
WEND
IF o=0 AND nn > maxnr(index) THEN LOCATE 20,12:PRINT "nicht vorhanden":taste q:GOTO haupt
en=0
WHILE en<1 OR (o=0 AND en>maxnr(index))
  LOCATE 8,14:PRINT "Endnummer ";:lies q$,5
  IF ASC(q$+" ")=129 THEN haupt
  long&=VAL(q$)
  IF long&<=maxint THEN en=long&
WEND
LOCATE 22,14:PRINT "weiter (Cr) oder Ende (F10)"
q=0
WHILE q<>13 AND q<>138 AND q<>129
  taste q
WEND
IF q=138 OR q=129 THEN haupt
IF o=0 THEN
  ll=maxnr(index)*(jj-j(index))+nn:le=ll-nn+en
ELSE
  ll=nn:le=en
END IF
oeffne (weg$+t$(index)),1,satzl,0:io=-1:REM abzuziehen
FIELD 1,satzl AS d$
laenge=LOF(1)/satzl
IF ll>laenge THEN CLOSE 1:LOCATE 20,14:PRINT "Nicht vorhanden!":taste q:GOTO haupt
IF le>laenge THEN le=laenge
FOR l=ll TO le
  GET 1,l:decodiere d$
  IF dat(0)>0 OR geszahl>0 THEN
    io=io+1
  ELSE
    LSET d$=CHR$(240)+STRING$(satzl-1,0):PUT 1,l
  END IF
NEXT l
 CLOSE 1
z(zmax,index)=z(zmax,index)-le+ll+io:dr(index)=dr(index)OR 4:dr(0)=dr(0)OR 4
CLS
LOCATE 22,14:PRINT "weiter (Cr) oder Ende (F10)"
WHILE true
  taste q
  IF q=13 THEN bereichesperren
  IF q=138 OR q=129 THEN haupt
WEND
dateierweitern:
CLS
LOCATE 6,28:PRINT "Dateien erweitern"
LOCATE 8,28:PRINT "1.Dateien erweitern"
LINE (210,52)-(374,68),1,b
LOCATE 11,28:PRINT "2.Dateiende suchen"
LINE (210,76)-(366,92),1,b
q=0
WHILE q<1 OR q>2
  taste q
  IF q=129 THEN haupt
  q=q-ASC("0")
  IF mausx>209 THEN
    IF mausx<375 AND mausy>51 AND mausy<69 THEN
      q=1
    ELSEIF mausx<367 AND mausy>75 AND mausy<93 THEN
      q=2
    END IF
  END IF
WEND
IF q=2 THEN 4310
GOSUB 4650
GOSUB 4320
LOCATE 8,12:PRINT "von "
l=laenge+1:sn=l:jahreszahl l,aj,sn
IF j(index)>-1 THEN LOCATE 8,18:PRINT "Jahrgang "aj
LOCATE 10,18:PRINT "Nummer "sn
LOCATE 12,12:PRINT "bis"
IF j(index)>-1 THEN
  LOCATE 12,18:PRINT "Jahrgang":q$=RIGHT$(STR$(aj),LEN(STR$(aj))-1)
  ej=-1
  WHILE ej>99 OR ej<0 OR q$="" OR (ej=0 AND INSTR("00",q$)=0)
    LOCATE 12,27:lies q$,4:ej=VAL(q$)
    IF ASC(q$+" ")=129 THEN haupt
  WEND
  IF ej<aj THEN ej=ej+100
END IF
LOCATE 14,18:PRINT "Nummer":q$=""
en=0
WHILE en<1 OR (j(index)>-1 AND en>maxnr(index)) OR ((j(index)=-1 OR aj=ej)AND en<sn)
  LOCATE 14,25:lies q$,5
  IF ASC(q$+" ")=129 THEN haupt
  long&=VAL(q$)
  IF long&<=maxint THEN en=long&
WEND
IF j(index)=-1 THEN
  al=sn:sl=en
ELSE
  al=maxnr(index)*(aj-j(index))+sn
  sl=maxnr(index)*(ej-j(index))+en
END IF
oeffne (weg$+t$(index)),1,satzl,0
FIELD 1,satzl AS d$
fehler=0
ON ERROR GOTO fehlerausw
LSET d$=STRING$(satzl,0)
FOR j=al TO sl:LOCATE 20,30:PRINT j
  PUT 1,j
IF fehler=61 THEN
  sl=j-1
  LOCATE 22,9:PRINT "Die Diskette ist voll."
  taste q
  fehler=0
  GOTO 4010
END IF
NEXT j
4010
ON ERROR GOTO 0
CLOSE 1
z(zmax,index)=z(zmax,index)+sl-al+1:dr(index)=dr(index) OR 4:dr(0)=dr(0)OR 4
GOTO haupt
4320
 oeffne (weg$+t$(index)),1,satzl,0
 laenge=LOF(1)/satzl
 CLOSE 1
RETURN
REM ------ ende suchen ------
4310
GOSUB 4650:GOSUB 4320
CLS
jahreszahl laenge,jj,l
IF j(index)>-1 THEN LOCATE 8,18:PRINT "Ende: Jahr "jj
LOCATE 10,18:PRINT "Endnummer "l
LOCATE 22,15:PRINT "(Taste)"
taste q
GOTO haupt
REM --------- eingabe zu gross
4570
CLOSE 1
CLS
LOCATE 5,15:PRINT "Für diese Nummer ist noch kein"
LOCATE 7,15:PRINT "Platz vorbereitet"
LOCATE 10,15:PRINT "(1 - 4 wählen)"
LOCATE 19,15:PRINT "(Taste)"
taste q
GOTO haupt
REM ---titel auflisten -------
4650
CLS
LOCATE 21,5:PRINT "Suche mit Cursortaste, mit Cr ":LOCATE 21,35
IF au=0 THEN PRINT "Übernehmen." :ELSE PRINT "wechseln. Ende mit F10, alle mit F6"
LOCATE 22,13:PRINT "Runter/hoch: +/- 1, rechts/links +/- 10"
LINE (224,100)-(264,116),2,bf
LINE (265,100)-(304,116),3,bf
LINE (305,100)-(352,116),2,bf
LINE (353,100)-(392,116),3,bf
LINE (544,140)-(576,156),2,bf
LINE (543,139)-(577,157),3,b
COLOR 3,2:LOCATE 19,70:PRINT "OK":COLOR 1,0
IF au<>0 THEN
  LINE (392,28)-(440,44),2,bf
  LINE (496,28)-(542,44),2,bf
  LOCATE 5,64:COLOR ,2:PRINT "Alle"
END IF
COLOR ,2
LOCATE 14,30:PRINT "+10"
LOCATE 14,41:PRINT "+1"
COLOR ,3
LOCATE 14,35:PRINT "-10"
LOCATE 14,47:PRINT "-1"
COLOR ,0
IF i<1 OR i> an THEN i=INT(an/2)
IF au>0 THEN LOCATE 3,49:PRINT "Ausdruck"
REM schleife
4740
IF i<1 THEN i=i+an :ELSE IF i>an THEN i=i-an
index=in(i):LOCATE 5,5:PRINT  USING"#####";i:LOCATE 5,11:PRINT USING "\                            \";t$(index)
4755
IF au>0 THEN
  COLOR ,2
  LOCATE 5,51:IF (dr(index)AND 1)=1 THEN PRINT " ja " :ELSE PRINT "nein"
  COLOR ,0
END IF
4760
taste q
IF q=129 THEN RETURN haupt
IF mausy>-1 THEN 4900
IF q=28 THEN i=i-1:GOTO 4740
IF q=29 THEN i=i+1:GOTO 4740
IF an>=11 THEN
  IF q=30 THEN i=i+10:GOTO 4740
  IF q=31 THEN i=i-10:GOTO 4740
END IF
IF (q=13 AND au=0) OR (q=138) GOTO 4830
4815
IF q=13 AND au=2 THEN
  dr(index)=(dr(index)XOR 1)OR 8
  dr(0)=dr(0)OR 4
  GOTO 4755
END IF
4820
IF au=2 AND q=134 THEN
  x=(dr(index)AND 1)OR 8
  FOR j=1 TO an
    dr(j)=(dr(j)AND 254)OR x
  NEXT j
  dr(0)=dr(0)OR 4
END IF
GOTO 4760
4830
CLS:o=1:RETURN
4900
IF ABS(mausx-308)<85 AND ABS(mausy-108)<9 THEN
  IF mausx>352 THEN
    i=i-1
  ELSEIF mausx>304 THEN
    i=i+1
  ELSEIF an>10 THEN
    IF mausx>264 THEN
      i=i-10
    ELSE
      i=i+10
    END IF
  END IF
GOTO 4740
END IF
IF (mausx>391) AND (mausx<441) AND (mausy>27)AND (mausy<45) THEN q=13:GOTO 4815
IF (mausx>542) AND (mausx<578) AND (mausy>138)AND (mausy<158) THEN 4830
IF mausx>495 AND mausx<543 AND mausy>27 AND mausy<45 THEN q=134:GOTO 4820
GOTO 4760
REM --grosse auswertung ---
neueausw:
CLS:bs=-1
LOCATE 5,33:PRINT "Neue Auswertung"
LOCATE 8,33:PRINT "1. eine Sorte"
LINE (250,52)-(366,68),1,b
LOCATE 11,33:PRINT "2. Gesamtauswertung"
LINE (250,76)-(414,92),1,b
o=0
WHILE o<1 OR o>2
  taste o
  IF o=129 THEN haupt
  o=o-ASC("0")
  IF mausx>249 THEN
    IF mausx<367 AND ABS(mausy-60)<9 THEN
      o=1
    ELSEIF mausx<415 AND ABS(mausy-84)<9 THEN
      o=2
    END IF
  END IF
WEND
CLS
FOR j=0 TO zmax-1:a(j)=0:NEXT j
fehlend=0:gesamt=0:doppelt=0:anzahl=0
IF o=2 THEN FOR i=1 TO an:index=in(i) :ELSE GOSUB 4650:CLS:GOSUB 6010
 LOCATE 1,4:PRINT USING "\                            \";t$(index)
 LOCATE 1,45:PRINT "Space : Bildschirmanzeige an/aus"
 oeffne (weg$+t$(index)),1,satzl,0
 FIELD 1,satzl AS d$
 laenge=LOF(1)/satzl
 FOR l=1 TO laenge
   GET 1,l
   decodiere d$
   IF dat(0)=0 THEN
     FOR j=bestZust TO zmax-1:a(j)=a(j)+dat(j+1):NEXT j
     gesamt=gesamt+1
     IF geszahl=0 THEN
       fehlend=fehlend+1
     ELSE
       doppelt=doppelt+geszahl-1
       anzahl=anzahl+geszahl
     END IF
     bs$=INKEY$
     IF bs$<>"" THEN
       IF bs$=" " THEN bs=NOT(bs) :ELSE IF ASC(bs$)=129 THEN CLOSE 1:GOTO haupt
     END IF
     IF bs THEN GOSUB 6095
   END IF
 NEXT l
 CLOSE 1
 ok=(z(zmax,index)=gesamt AND z(zmax+1,index)=doppelt)
 FOR j=0 TO zmax-1:ok=ok AND (z(j,index)=a(j)):NEXT j
 IF NOT ok THEN
   FOR j=0 TO zmax-1
     z(j,index)=a(j)
   NEXT j
   z(zmax,index)=gesamt
   z(zmax+1,index)=doppelt
   dr(index)=dr(index) OR 4:dr(0)=dr(0)OR 4
 END IF
 GOSUB 6095
 FOR j=0 TO zmax-1:a(j)=0:NEXT j
 fehlend=0:gesamt=0:doppelt=0:anzahl=0
IF o=2 THEN NEXT i
GOTO haupt

6000
LOCATE 1,19:PRINT q$
6010
LOCATE 3,2:PRINT "Anzahl "
FOR j=0 TO zmax-1:LOCATE 3+j,10:PRINT j;":":NEXT j
LOCATE zmax+4,2:PRINT "Gesamt"
LOCATE zmax+5,2:PRINT "fehlend"
LOCATE zmax+6,2:PRINT "doppelt"
REM werte schreiben
6095
FOR j=0 TO zmax-1
  LOCATE 3+j,14:PRINT  USING"######";a(j)
  IF anzahl>0 THEN LOCATE 3+j,23:PRINT  USING"####.## %";100*a(j)/anzahl;
NEXT j
LOCATE zmax+4,14:PRINT  USING"######";anzahl
IF gesamt>0 THEN LOCATE zmax+4,23:PRINT USING"####.## %";100*(gesamt-fehlend)/gesamt;
LOCATE zmax+5,14:PRINT  USING"######";fehlend
IF gesamt>0 THEN LOCATE zmax+5,23:PRINT  USING"####.## %";100*fehlend/gesamt;
LOCATE zmax+6,14:PRINT  USING"######";doppelt
IF anzahl>0 THEN LOCATE zmax+6,23:PRINT  USING"####.## %";100*doppelt/anzahl;
RETURN

abmelden:
CLS
IF an>0 THEN
  GOSUB 8010
  IF (dr(0)AND 4)>0 THEN GOSUB 8250
END IF
CLS
LOCATE 4,31:PRINT "A b m e l d e n"
LINE (274,53)-(400,67),1,b
LOCATE 8,36:PRINT "1. Amiga Basic"
LINE (274,77)-(432,91),1,b
LOCATE 11,36:PRINT "2. Workbench / CLI"
LINE (274,101)-(384,115),1,b
LOCATE 14,36:PRINT "3. Hauptmenü"
q=0
WHILE q<1 OR q>3
  taste q
  IF q=129 THEN haupt
  IF mausx>273 THEN
    IF mausx<401 AND mausy<68 AND mausy>52 THEN
      q=1
    ELSEIF mausx<433 AND mausy<92 AND mausy>76 THEN
      q=2
    ELSEIF mausx<385 AND mausy<116 AND mausy>100 THEN
      q=3
    END IF
  ELSE
    q=q-ASC("0")
  END IF
WEND
IF q=1 THEN
  END
ELSEIF q=2 THEN
  SYSTEM
ELSE
  GOTO haupt
END IF

8010
IF (dr(0)AND 4)>0 OR aa<>an OR va<>0 THEN
  oeffne Pfad$+"Zahlen",1,2,0
  PRINT "Zahlen"
  FIELD 1,2 AS d$
8015
  LSET d$=MKI$(an)
  PUT 1,1
  LSET d$=MKI$(zmax)
  PUT 1
  fehler=0
  ON ERROR GOTO fehlerausw
  FOR i=1 TO an
    IF (dr(i) AND 4)>0 THEN
8020
      LSET d$=MKI$(z(0,i)):PUT 1,3+(i-1)*(zmax+2)
      IF fehler=61 THEN
        GOSUB diskvoll
        GOTO 8020
      END IF
      FOR j=1 TO zmax+1
        LSET d$=MKI$(z(j,i)):PUT 1
        IF fehler=61 THEN
          GOSUB diskvoll
          GOTO 8015
        END IF
      NEXT j
    END IF
  NEXT i
  ON ERROR GOTO 0
  CLOSE 1
  dr(0)=dr(0)OR 8
END IF
IF voraend>0 THEN
  oeffne Pfad$+"Druckart",1,107,0
  FIELD 1,30 AS d$,1 AS bed$,1 AS lg$,5 AS t1$,5 AS t2$,1 AS lg2$,5 AS t3$,5 AS t4$,4 AS lg3$,50 AS t5$
  i=0
  WHILE (druckbits(i)<255) AND (i<10)
    LSET d$=druck$(i)
    LSET bed$=CHR$(druckbits(i))
    LSET lg$=CHR$(16*LEN(trenn$(i,10))+LEN(trenn$(i,11)))
    LSET t1$=trenn$(i,10)
    LSET t2$=trenn$(i,11)
    LSET lg2$=CHR$(16*LEN(trenn$(i,12))+LEN(trenn$(i,13)))
    LSET t3$=trenn$(i,12)
    LSET t4$=trenn$(i,13)
    IF (druckbits(i)AND 32)>0 THEN
      q$="":lg&=0
      FOR j=0 TO zmax-1
        lg&=lg&*8+LEN(trenn$(i,zmax-1-j))
        q$=q$+trenn$(i,j)+SPACE$(5-LEN(trenn$(i,j)))
      NEXT j
      LSET lg3$=MKL$(lg&)
      LSET t5$=q$
    END IF
    i=i+1
    PUT 1,i
  WEND
  WHILE i<10
    LSET d$=""
    LSET bed$=CHR$(255)
    i=i+1
    PUT 1,i
  WEND
  CLOSE 1
  dr(0)=dr(0)OR 64
  voraend=0
END IF
IF aa<>an OR va<>0 THEN
  oeffne Pfad$+"Titel",1,34,0:PRINT "Titel"
  FIELD 1,1 AS laenge$,30 AS d$,1 AS jahr$,2 AS mnr$
  ON ERROR GOTO fehlerausw
  fehler=0
  FOR i=aa+1 TO an
8030
    IF j(i)>-1 THEN q$=CHR$(j(i)) :ELSE q$=CHR$(100)
    LSET laenge$=CHR$(LEN(t$(i)))
    LSET d$=t$(i)
    LSET jahr$=q$
    LSET mnr$=MKI$(maxnr(i))
    PUT 1,i
    IF fehler=61 THEN
      GOSUB diskvoll
      GOTO 8030
    END IF
  NEXT i
  CLOSE 1
  dr(0)=dr(0)OR 16
  oeffne Pfad$+"Index",1,2,0:PRINT "Index"
  FIELD 1,2 AS d$
  FOR i=1 TO an
8040
    LSET d$=MKI$(in(i)):PUT 1,i
    IF fehler=61 THEN
      GOSUB diskvoll
      GOTO 8040
    END IF
  NEXT i
  ON ERROR GOTO 0
  CLOSE 1
  dr(0)=dr(0)OR 2
aa=an:va=0
END IF
CLS:RETURN
8250
oeffne Pfad$+"Voreinstellung",1,1,0:PRINT "Voreinstellung"
FIELD 1,1 AS d$
dr(0)=dr(0)OR 32
ON ERROR GOTO fehlerausw
fehler=0
FOR i=0 TO an
8260
  IF (dr(i)AND 4)>0 THEN
    LSET d$=CHR$((dr(i)AND 1)OR 2):PUT 1,i+1:dr(i)=dr(i)AND 243
  ELSEIF (dr(i)AND 8)>0 THEN
    LSET d$=CHR$(dr(i)AND 3):PUT 1,i+1:dr(i)=dr(i)AND 243
  END IF
  IF fehler=61 THEN
    GOSUB diskvoll
    GOTO 8260
  END IF
NEXT i:CLOSE 1
RETURN
diskvoll:
 CLS
 LOCATE 5,5:PRINT "Die Diskette ist voll. Bitte schaffen Sie Platz"
 LOCATE 6,5:PRINT "für die Dateien, indem Sie (mit dem CLI) einige Dateien"
 LOCATE 7,5:PRINT "aus dem Verzeichnis 'comdat' auf eine andere Diskette kopieren,"
 LOCATE 8,5:PRINT "und hier löschen. Dann geht's mit einem Tastendruck weiter."
 taste q
 fehler=0
RETURN
werteladen:
q=1
oeffne (Pfad$+"Zahlen"),1,2,q
IF q=1 THEN GOSUB 16000:GOTO werteladen
FIELD 1,2 AS d$
GET 1,1:an=CVI(d$):GET 1:zmax=CVI(d$):zmax$=RIGHT$(STR$(zmax-1),LEN(STR$(zmax-1))-1):satzl=(zmax+2)\2
IF (FRE(0)-1000)\70 <= an THEN CLOSE 1:CLEAR ,(an+200)*70+70000:GOTO anfang
mq=an+50:IF mq<200 THEN mq=200
DIM t$(mq),j(mq),z(2+zmax,mq),dr(mq),in(mq),maxnr(mq),de(3),de$(4),dat(2*satzl),a(zmax-1),druck$(9),druckbits(10),trenn$(9,13)
FOR i=0 TO zmax-1:a(i)=0:NEXT i
IF an>0 THEN
  FOR i=1 TO an
    FOR j=0 TO zmax+1
      GET 1
      z(j,i)=CVI(d$)
    NEXT j
  NEXT i
  CLOSE 1
  oeffne Pfad$+"Titel",1,34,0
  FIELD 1,1 AS laenge$,30 AS d$,1 AS jahr$,2 AS mnr$
  FOR i=1 TO an
    GET 1,i:t$(i)=LEFT$(d$,ASC(laenge$)):j(i)=ASC(jahr$):maxnr(i)=CVI(mnr$)
    IF j(i)>=100 THEN j(i)=-1
  NEXT i
  CLOSE 1
  oeffne Pfad$+"Index",1,2,0
  FIELD 1,2 AS d$
  FOR i=1 TO an
    GET 1,i:in(i)=CVI(d$)
  NEXT i:CLOSE 1
  oeffne Pfad$+"Voreinstellung",1,1,0
  FIELD 1,1 AS d$
  FOR i=0 TO an
    GET 1,i+1:dr(i)=ASC(d$)
  NEXT i:
END IF
CLOSE 1
oeffne Pfad$+"Drucker",1,1,0
CLOSE 1
OPEN Pfad$+"Drucker" FOR INPUT AS 1
 INPUT#1,komplpfad$
 INPUT#1,lib$
 INPUT#1,zwsp$
 FOR i=0 TO 3
   INPUT#1,de$(i)
 NEXT i
 FOR i=0 TO 2
   de(i)=CVI(INPUT$(2,1))
 NEXT i
 CLOSE 1:de(3)=(de(2)\2)-2
 de$(4)=SPACE$(4+de(2) MOD 2)
 oeffne Pfad$+"Druckart",1,107,0
 FIELD 1,30 AS d$,1 AS bed$,1 AS lg$,5 AS t1$,5 AS t2$,1 AS lg2$,5 AS t3$,5 AS t4$,4 AS lg3$,50 AS t5$
 i=0
 GET 1,1
 druckbits(i)=ASC(bed$)
 WHILE (druckbits(i)<255)AND (i<10)
   GET 1,i+1
   druckbits(i)=ASC(bed$)
   druck$(i)=d$
   trenn$(i,10)=LEFT$(t1$,ASC(lg$)\16)
   trenn$(i,11)=LEFT$(t2$,ASC(lg$)AND 15)
   trenn$(i,12)=LEFT$(t3$,ASC(lg2$)\16)
   trenn$(i,13)=LEFT$(t4$,ASC(lg2$)AND 15)
   lg&=CVL(lg3$)
   IF (druckbits(i)AND 32)>0 THEN
     FOR j=0 TO zmax-1
       trenn$(i,j)=MID$(t5$,1+5*j,lg& AND 7)
       lg&=lg&\8
     NEXT j
   END IF
   i=i+1
 WEND
CLOSE 1
RETURN
ausdruck:
CLS
LOCATE 6,8:PRINT "       A U S D R U C K     "
LINE (50,53)-(276,67),1,b
LOCATE 8,8:PRINT "1. Auswahl bestimmter Hefte"
LINE (50,77)-(246,91),1,b
LOCATE 11,8:PRINT "2. Ausdruck einer Sorte"
LINE (50,101)-(340,115),1,b
LOCATE 14,8:PRINT "3. Ausdruck in Heftformat : Auswahl"
LINE (50,125)-(366,139),1,b
LOCATE 17,8:PRINT "4. Ausdruck in Heftformat : eine Sorte"
da=0
WHILE da<1 OR da>4
  taste da
  IF da=129 THEN haupt
  IF mausx>49 THEN
    IF mausx<277 AND mausy<68 AND mausy>52 THEN
      da=1
    ELSEIF mausx<247 AND mausy<92 AND mausy>76 THEN
      da=2
    ELSEIF mausx<341 AND mausy<116 AND mausy>100 THEN
      da=3
    ELSEIF mausx<367 AND mausy<140 AND mausy>124 THEN
      da=4
    ELSE
      da=0
    END IF
  ELSE
    da=da-ASC("0")
  END IF
WEND
ON da GOTO 8680,9200,9250,9260
REM -----Auswahl der zu druckenden Hefte-----
8580
CLS
LINE (26,29)-(228,43),1,b
LOCATE 5,5:PRINT "1. Vorauswahl übernehmen"
LINE (26,53)-(213,67),1,b
LOCATE 8,5:PRINT "2. Vorauswahl abändern"
LOCATE 15,5:au=0
WHILE au<1 OR au>2
  taste au
  IF au=129 THEN RETURN haupt
  IF mausx>25 THEN
    IF mausx<229 AND mausy>26 AND mausy<46 THEN
      au=1
    ELSEIF mausx<214 AND mausy>52 AND mausy<68 THEN
      au=2
    END IF
  ELSE
    au=au-ASC("0")
  END IF
WEND
o=0
RETURN
8680
GOSUB 8580
IF au=2 THEN GOSUB 4650:o=0
GOSUB 9300
8690
CLS
LOCATE 1,36:PRINT "Ausdruck"
LOCATE 8,3:PRINT "Bitte den Drucker so einstellen, daß der Druckkopf am Blattanfang steht."
LOCATE 9,3:PRINT "Dann Taste drücken!"
 taste q
 IF q=129 THEN haupt
OPEN de$(3) FOR OUTPUT AS 4
PRINT #4,de$(0);
CLOSE 4
OPEN "prt:" FOR OUTPUT AS 4
zz=1
IF o=0 THEN FOR i=1 TO an
 index=in(i)
 IF o=0 AND (dr(index)AND 1)=0 THEN 9170
 IF jx=3 AND z(zmax+1,index)=0 THEN 9170
 IF jx=2 THEN
   q=0:FOR j=0 TO zmax-1:q=q+z(j,index):NEXT j
   IF q-z(zmax,index)-z(zmax+1,index)>=0 THEN 9170
 END IF
 LOCATE 10,10:PRINT USING "\                            \";t$(index)
 oeffne weg$+t$(index),1,satzl,0
 FIELD 1,satzl AS d$
 laenge=LOF(1)/satzl
 FOR l=1 TO laenge
   IF zz=1 THEN
     IF jx=2 THEN CALL titelleiste(4) :ELSE CALL titelleiste (3)
     zz=2
   END IF
   IF ASC(INKEY$+" ")=129 THEN
     LOCATE 12,10:PRINT "Ende = Cr, weiter = f10"
     q=0
     WHILE q<>13 AND q<>138 AND q<>129
       taste q
     WEND
     IF q=13 OR q=129 THEN CLOSE 1:CLOSE 4:GOTO haupt
     LOCATE 12,10:PRINT SPACE$(24)
   END IF
   GET 1,l:decodiere d$
   IF dat(0)=0 THEN
     jahreszahl l,j,nr
     IF (jx=1 AND geszahl>0) OR (jx=3 AND geszahl>1) THEN
       PRINT #4,USING"\                            \";t$(index);
       IF j(index)>-1 THEN PRINT #4,USING"####";j; :ELSE PRINT #4,"    ";
       PRINT #4,USING "##### ";nr;
       PRINT #4,SPACE$(bestZust*3);
       FOR j=bestZust+1 TO zmax:
         IF dat(j)>0 THEN PRINT #4,USING "###";dat(j); :ELSE PRINT #4,"   ";
       NEXT:PRINT #4,USING "######";geszahl
       zz=zz+1
       IF zz>=de(0)-1 THEN
         zz=1
         CLOSE 4
         OPEN de$(3) FOR OUTPUT AS 4
         PRINT #4,de$(1);de$(1);
         CLOSE 4
         OPEN "prt:" FOR OUTPUT AS 4
       END IF
     ELSEIF jx=2 AND geszahl=0 THEN
       PRINT #4,USING"\                            \";t$(index);
       IF j(index)>-1 THEN PRINT #4,USING"####";j; :ELSE PRINT #4,"    ";
       PRINT #4,USING "#####";nr
       IF zz>=de(0)-1 THEN
         zz=1
         CLOSE 4
         OPEN de$(3) FOR OUTPUT AS 4
         PRINT #4,de$(1);de$(1);
         CLOSE 4
         OPEN "prt:" FOR OUTPUT AS 4
       END IF
     END IF
   END IF
 NEXT l
 CLOSE 1
 CLOSE 4
 OPEN de$(3) FOR OUTPUT AS 4
 PRINT #4,de$(1);
 zz=zz+1
 IF zz>=de(0)-1 THEN
   zz=1
   PRINT #4,de$(1);
   CLOSE 4
   OPEN "prt:" FOR OUTPUT AS 4
 END IF
9170
IF o=0 THEN NEXT i
CLOSE 4:au=0
GOTO haupt

REM ausdr nur eine sorte
9200
GOSUB 4650
GOSUB 9300
GOTO 8690
REM ausdruck in heftformat
9250
GOSUB 8580
IF au=2 THEN GOSUB 4650
GOSUB 9500:o=0:GOTO 9600
REM ausdruck in heftformat eine sorte
9260
GOSUB 4650:GOSUB 9500:GOTO 9600
9300
CLS:io=0
LINE (26,29)-(188,43),1,b
LOCATE 5,5:PRINT "1. Vorhandene Hefte"
LINE (26,53)-(172,67),1,b
LOCATE 8,5:PRINT "2. Fehlende Hefte"
LINE (26,77)-(132,91),1,b
LOCATE 11,5:PRINT "3. Mehrfache"
LOCATE 15,5:jx=0
WHILE jx<1 OR jx>3
  taste jx
  IF jx=129 THEN au=0:RETURN haupt
  IF mausx>25 THEN
    IF mausx<189 AND mausy>28 AND mausy<44 THEN
      jx=1
    ELSEIF mausx<173 AND mausy>52 AND mausy<68 THEN
      jx=2
    ELSEIF mausx<133 AND mausy>76 AND mausy<92 THEN
      jx=3
    END IF
  ELSE
    jx=jx-ASC("0")
  END IF
WEND
RETURN
9500
CLS
MENU 4,0,1,"Voreinstellung"
j=0
WHILE (druckbits(j)<255)AND(j<10)
  MENU 4,j+1,1,druck$(j)
  j=j+1
WEND
MENU 4,j+1,1,"neu"
MENU 4,j+2,1,"löschen"
vanz=j
ja1$="<<":ja2$=">> ":nv1$="(":nv2$=")"
FOR j=0 TO zmax-1:zust$(j)=RIGHT$(STR$(j),LEN(STR$(j))-1):NEXT j
9510
 REM 4
CLS:LOCATE 1,32:PRINT "A u s d r u c k"
MENU 1,0,0:MENU 2,0,0:MENU 3,0,0
IF vanz>0 THEN
  men1=1
  GOSUB 9560
ELSE
  b2=true:b3=false:b4=false:b5=false:b6=false:b7=false 'Voreinst
  GOSUB 9550:GOSUB 9551:GOSUB 9552:GOSUB 9553:GOSUB 9554:GOSUB 9555
END IF
LINE (544,140)-(576,156),2,bf
COLOR 3,2:LOCATE 19,70:PRINT "OK"
LINE (543,139)-(577,157),3,b
COLOR 1,0:LOCATE 23,4:PRINT "Auswahl mit den Cursortasten, Ende mit F10, Trennzeichen ändern mit F6";
9512
COLOR 0,1:LOCATE 4,23:IF b2 THEN PRINT " ja " :ELSE PRINT "nein"
9514
taste q
IF q=129 THEN COLOR 1,0:RETURN haupt
IF q=134 THEN GOSUB 9565:GOTO 9514
IF men0>0 THEN GOSUB 9560  'evtl goto wg f1
IF mausx>-1 THEN
  COLOR 1,0:LOCATE 4,23:IF b2 THEN PRINT " ja " :ELSE PRINT "nein"
  GOTO 9570
END IF
IF q=138 GOTO 9580
IF q<29 OR q>31 THEN 9514
9515
IF q=30 OR q=31 THEN
  b2=NOT(b2)
  IF NOT(b2) THEN
    b3=false
    b6=false
    b7=false
    b4=false
    GOSUB 9551:GOSUB 9552:GOSUB 9554:GOSUB 9555
  END IF
  GOSUB 9550
  GOTO 9512
END IF
COLOR 1,0:LOCATE 4,23:IF b2 THEN PRINT " ja " :ELSE PRINT "nein"
9516
COLOR 0,1:LOCATE 4,56:IF b3 OR NOT(b2) THEN PRINT " ja " :ELSE PRINT "nein"
9518
taste q
IF q=129 THEN COLOR 1,0:RETURN haupt
IF q=134 THEN GOSUB 9565:GOTO 9518
IF men0>0 THEN GOSUB 9560
IF mausx>-1 THEN
  COLOR 1,0:LOCATE 4,56:IF b3 OR NOT(b2) THEN PRINT " ja " :ELSE PRINT "nein"
  GOTO 9570
END IF
IF q=138 GOTO 9580
IF q<28 OR q>31 THEN 9518
9519
IF q=30 OR q=31 THEN
  b3=NOT(b3)AND b2
  IF b3 THEN
    b4=false
    b5=false
    GOSUB 9552:GOSUB 9553
  END IF
  GOSUB 9551
  GOTO 9516
ELSE
  COLOR 1,0:LOCATE 4,56:IF b3 OR NOT(b2) THEN PRINT " ja " :ELSE PRINT "nein"
  IF q=28 GOTO 9512 :ELSE GOTO 9520
END IF
9520
COLOR 0,1:LOCATE 7,23:IF b4 THEN PRINT " ja " :ELSE PRINT "nein"
9522
taste q
IF q=129 THEN COLOR 1,0:RETURN haupt
IF q=134 THEN GOSUB 9565:GOTO 9522
IF men0>0 THEN GOSUB 9560
IF mausx>-1 THEN
  COLOR 1,0:LOCATE 7,23:IF b4 THEN PRINT " ja " :ELSE PRINT "nein"
  GOTO 9570
END IF
IF q=138 GOTO 9580
IF q<28 OR q>31 THEN 9522
9523
IF q=30 OR q=31 THEN
  b4=NOT(b4)
  IF b4 THEN
    b2=true
    b7=false
    GOSUB 9550:GOSUB 9555
  END IF
  GOSUB 9552
  GOTO 9520
ELSE
  COLOR 1,0:LOCATE 7,23:IF b4 THEN PRINT " ja " :ELSE PRINT "nein"
  IF q=28 GOTO 9516 :ELSE GOTO 9524
END IF
9524
COLOR 0,1:LOCATE 10,23:IF b5 THEN PRINT " ja " :ELSE PRINT "nein"
9526
taste q
IF q=129 THEN COLOR 1,0:RETURN haupt
IF q=134 THEN GOSUB 9565:GOTO 9526
IF men0>0 THEN GOSUB 9560
IF mausx>-1 THEN
  COLOR 1,0:LOCATE 10,23:IF b5 THEN PRINT " ja " :ELSE PRINT "nein"
  GOTO 9570
END IF
IF q=138 GOTO 9580
IF q<28 OR q>31 THEN 9526
9527
IF q=30 OR q=31 THEN
  b5=NOT(b5)
  IF b5 THEN
    b3=false
    b6=false
    b7=false
    GOSUB 9551:GOSUB 9554:GOSUB 9555
  END IF
  GOSUB 9553
  GOTO 9524
ELSE
  COLOR 1,0:LOCATE 10,23:IF b5 THEN PRINT " ja " :ELSE PRINT "nein"
  IF q=28 GOTO 9520 :ELSE GOTO 9528
END IF
9528
COLOR 0,1:LOCATE 13,23:IF b6 THEN PRINT " ja " :ELSE PRINT "nein"
9530
taste q
IF q=129 THEN COLOR 1,0:RETURN haupt
IF q=134 THEN GOSUB 9565:GOTO 9530
IF men0>0 THEN GOSUB 9560
IF mausx>-1 THEN
  COLOR 1,0:LOCATE 13,23:IF b6 THEN PRINT " ja " :ELSE PRINT "nein"
  GOTO 9570
END IF
IF q=138 GOTO 9580
IF q<28 OR q>31 THEN 9530
9531
IF q=30 OR q=31 THEN
  b6=NOT(b6)
  IF b6 THEN
    b2=true
    b5=false
    b7=false
    GOSUB 9550:GOSUB 9553:GOSUB 9555
  END IF
  GOSUB 9554
  GOTO 9528
ELSE
  COLOR 1,0:LOCATE 13,23:IF b6 THEN PRINT " ja " :ELSE PRINT "nein"
  IF q=28 GOTO 9524 :ELSE GOTO 9532
END IF
9532
COLOR 0,1:LOCATE 16,56:IF b7 THEN PRINT " ja " :ELSE PRINT "nein"
9534
taste q
IF q=129 THEN COLOR 1,0:RETURN haupt
IF q=134 THEN GOSUB 9565:GOTO 9534
IF men0>0 THEN GOSUB 9560
IF mausx>-1 THEN
  COLOR 1,0:LOCATE 16,56:IF b7 THEN PRINT " ja " :ELSE PRINT "nein"
  GOTO 9570
END IF
IF q=138 GOTO 9580
IF q<28 OR q>31 OR q=29 THEN 9534
9535
IF q=30 OR q=31 THEN
  b7=NOT(b7)
  IF b7 THEN
    b2=true
    b4=false
    b5=false
    b6=false
    GOSUB 9550:GOSUB 9552:GOSUB 9553:GOSUB 9554
  END IF
  GOSUB 9555
  GOTO 9532
END IF
COLOR 1,0:LOCATE 16,56:IF b7 THEN PRINT " ja " :ELSE PRINT "nein"
GOTO 9528

9550
 IF b2 THEN col=2 :ELSE col=3
 COLOR col,0
 IF b2 AND (b3 OR b6 OR b7) THEN GOSUB mus4:PATTERN ,muster
 LINE (28,21)-(164,34),col,bf
 LINE (27,20)-(165,35),1,b
 COLOR 1,col:LOCATE 4,5:PRINT "Vorhandene Hefte"
 IF b2 AND (b3 OR b6 OR b7) THEN GOSUB mus11:PATTERN ,muster
 COLOR 1,0
 LOCATE 4,23:IF b2 THEN PRINT " ja " :ELSE PRINT "nein"
RETURN
9551
 IF b3 OR NOT(b2) THEN col=2 :ELSE col=3
 COLOR col,0
 IF NOT(b3) AND (NOT (b2) OR b4 OR b5) THEN GOSUB mus4:PATTERN ,muster
 LINE (308,21)-(428,34),col,bf
 LINE (307,20)-(429,35),1,b
 COLOR 1,col:LOCATE 4,40:PRINT "fehlende Hefte"
 IF NOT(b3) AND (NOT(b2) OR b4 OR b5) THEN GOSUB mus11:PATTERN ,muster
 COLOR 1,0
 LOCATE 4,56:IF b3 OR NOT(b2) THEN PRINT " ja " :ELSE PRINT "nein"
RETURN
9552
 IF b4 THEN col=2 :ELSE col=3
 COLOR col,0
 IF NOT(b4) AND(b7 OR b3 OR NOT(b2)) THEN GOSUB mus4:PATTERN ,muster
 LINE (28,45)-(140,58),col,bf
 LINE (27,44)-(141,59),1,b
 COLOR 1,col:LOCATE 7,5:PRINT "nur Mehrfache"
 IF NOT(b4) AND (b7 OR b3 OR NOT(b2)) THEN GOSUB mus11:PATTERN ,muster
 COLOR 1,0
 LOCATE 7,23:IF b4 THEN PRINT " ja " :ELSE PRINT "nein"
RETURN
9553
 IF b5 THEN col=2 :ELSE col=3
 IF NOT(b5)AND (b6 OR b7 OR b3) THEN GOSUB mus4:PATTERN ,muster
 LINE (28,69)-(148,82),col,bf
 LINE (27,68)-(149,83),1,b
 COLOR 1,col:LOCATE 10,5:PRINT "zusammengefaßt"
 IF NOT(b5)AND (b6 OR b7 OR b3) THEN GOSUB mus11:PATTERN ,muster
 COLOR 1,0
 LOCATE 10,23:IF b5 THEN PRINT " ja " :ELSE PRINT "nein"
RETURN
9554
 IF b6 THEN col=2 :ELSE col=3
 IF NOT(b6) AND (NOT(b2) OR b5 OR b7) THEN GOSUB mus4:PATTERN ,muster
 LINE (28,93)-(124,106),col,bf
 LINE (27,92)-(125,107),1,b
 COLOR 1,col:LOCATE 13,5:PRINT "mit Zustand"
 IF NOT(b6) AND (NOT(b2) OR b5 OR b7) THEN GOSUB mus11:PATTERN ,muster
 COLOR 1,0
 LOCATE 13,23:IF b6 THEN PRINT " ja " :ELSE PRINT "nein"
RETURN
9555
IF b7 THEN col=2 :ELSE col=3
 IF NOT(b7) AND (NOT(b2) OR b4 OR b5 OR b6) THEN GOSUB mus4:PATTERN ,muster
 LINE (28,117)-(428,130),col,bf
 LINE (27,116)-(429,131),1,b
 COLOR 1,col:LOCATE 16,5:PRINT "zusammengefaßt mit eingeschränkter Zustandsangabe"
 IF NOT(b7) AND (NOT(b2) OR b4 OR b5 OR b6) THEN GOSUB mus11:PATTERN ,muster
 COLOR 1,0
 LOCATE 16,56:IF b7 THEN PRINT " ja " :ELSE PRINT "nein"
RETURN

9560
COLOR 1,0
IF men1<=vanz THEN
  men1=men1-1
  b2=-(druckbits(men1) AND 1)
  b3=-SGN(druckbits(men1) AND 2)
  b4=-SGN(druckbits(men1) AND 4)
  b5=-SGN(druckbits(men1) AND 8)
  b6=-SGN(druckbits(men1) AND 16)
  b7=-SGN(druckbits(men1) AND 32)
  ja1$=trenn$(men1,10)
  ja2$=trenn$(men1,11)
  IF b2 IMP b3 THEN
    nv1$=trenn$(men1,12)
    nv2$=trenn$(men1,13)
  END IF
  IF b7 THEN
    FOR j=0 TO zmax-1
      zust$(j)=trenn$(men1,j)
    NEXT j
  END IF
  IF b6 THEN
    FOR j=0 TO zmax-1
      zust$=RIGHT$(STR$(j),LEN(STR$(j))-1)
    NEXT j
  END IF
  GOSUB 9550:GOSUB 9551:GOSUB 9552:GOSUB 9553:GOSUB 9554:GOSUB 9555
ELSEIF men1=vanz+2 AND vanz>0 THEN
  CLS
  LINE (544,140)-(576,156),2,bf
  COLOR 3,2:LOCATE 19,70:PRINT "OK"
  LINE (543,139)-(577,157),3,b
  COLOR 1,0
  IF vanz>1 THEN
    LOCATE 5,5:PRINT "Welche Voreinstellung soll gelöscht werden (0 - ";vanz-1;") ?"
    q=-1
    WHILE q<0 OR q>vanz-1
      taste q
      q=q-ASC("0")
      IF men0=4 THEN
        q=men1-1
      END IF
    WEND
  END IF
  LOCATE 7,5:PRINT druck$(q)
  LOCATE 22,5:PRINT "CR: löschen   F10: nicht löschen"
  mausx=-1:q1=0
  WHILE NOT(mausx>543 AND mausx<577 AND mausy>139 AND mausy<157) AND q1<>13 AND q1<>138 AND q1<>129
    taste q1
  WEND
  IF q1<>138 AND q1<> 129 THEN
    IF q<vanz-1 THEN
      FOR j=q+1 TO vanz-1
        druck$(j-1)=druck$(j)
        druckbits(j-1)=druckbits(j)
        FOR jj=0 TO 13
          trenn$(j-1,jj)=trenn$(j,jj)
        NEXT jj
      NEXT j
    END IF
    vanz=vanz-1
    druck$(vanz)=""
    druckbits(vanz)=255
    FOR jj=0 TO 13
      trenn$(vanz,jj)=""
    NEXT jj
    voraend=1
  END IF
  RETURN 9500
ELSEIF men1=vanz+1 AND vanz<10 THEN
  CLS
  nr=0
  IF vanz>0 THEN
    LOCATE 5,5:PRINT "Welche Nummer soll die Voreinstellung haben (0 - ";vanz;") ?"
    nr=-1
    WHILE nr<0 OR nr>vanz
      taste q
      nr=q-ASC("0")
      IF men0=4 THEN
        nr=men1-1
      END IF
    WEND
  END IF
  IF nr<vanz THEN
    FOR j=vanz TO nr+1 STEP -1
      druck$(j)=druck$(j-1)
      druckbits(j)=druckbits(j-1)
      FOR jj=0 TO 13
        trenn$(j,jj)=trenn$(j-1,jj)
      NEXT jj
    NEXT j
  END IF
  LOCATE 7,5:PRINT "Name:"
  q$=""
  WHILE q$=""
    LOCATE 7,11:lies q$,30
  WEND
  druck$(nr)=q$
  MENU 4,vanz+1,0
  MENU 4,vanz+2,0
  men0=0:men1=0
  GOSUB 9510
  CLS:LOCATE 2,5:PRINT druck$(nr)
  druckbits(nr)=-b2-2*b3-4*b4-8*b5-16*b6-32*b7
  trenn$(nr,10)="<<":trenn$(nr,11)=">>"
  LOCATE 4,5:PRINT "Trennzeichen für Jahrgang: ";:lies trenn$(nr,10),5
  LOCATE 4,40:lies trenn$(nr,11),5
  IF (b2 IMP b3) THEN
    trenn$(nr,12)="(":trenn$(nr,13)=")"
    LOCATE 6,5:PRINT "Trennzeichen für Fehlende: ";:lies trenn$(nr,12),5
    LOCATE 6,40:lies trenn$(nr,13),5
  END IF
  IF b7 THEN
    LOCATE 8,5:PRINT "Zustand, Bezeichnung"
    q$=""
    FOR j=0 TO zmax-1
      LOCATE 10+j,7:PRINT j
      LOCATE 10+j,12:lies q$,5
      trenn$(nr,j)=q$
    NEXT j
  END IF
  druckbits(vanz+1)=255
  voraend=1
  RETURN 9500
END IF
RETURN
9565
WINDOW 2,"",(10,10)-(600,160),2
CLS
 LOCATE 2,5:PRINT "Trennzeichen für Jahrgang: ";:lies ja1$,5
 LOCATE 2,40:lies ja2$,5
 IF (b2 IMP b3) THEN
   LOCATE 4,5:PRINT "Trennzeichen für Fehlende: ";:lies nv1$,5
   LOCATE 4,40:lies nv2$,5
 END IF
 IF b7 THEN
   LOCATE 6,5:PRINT "Zustand, Bezeichnung"
   q$=""
   FOR j=0 TO zmax-1
     LOCATE 8+j,7:PRINT j
     LOCATE 8+j,12:lies q$,5
     zust$(j)=q$
   NEXT j
 END IF
WINDOW CLOSE 2
RETURN

9570
 IF mausx>27 AND mausx<165 AND mausy>20 AND mausy<35 THEN q=30:GOTO 9515
 IF mausx>307 AND mausx<429 AND mausy>20 AND mausy<35 THEN q=30:GOTO 9519
 IF mausx>27 AND mausx<141 AND mausy>44 AND mausy<59 THEN q=30:GOTO 9523
 IF mausx>27 AND mausx<149 AND mausy>68 AND mausy<83 THEN q=30:GOTO 9527
 IF mausx>27 AND mausx<125 AND mausy>92 AND mausy<107 THEN q=30:GOTO 9531
 IF mausx>27 AND mausx<429 AND mausy>116 AND mausy<131 THEN q=30:GOTO 9535
 IF mausx>543 AND mausx<577 AND mausy>139 AND mausy<157 THEN 9580
GOTO 9512
9580
 COLOR 1,0
RETURN
9600
CLS:ig=0:q1=0
le$=SPACE$(de(3))
ii=(de(1)\2)-2
zq=((FRE(-1)-20000)\(ii*(de(3)+2)))*ii
q1$=LEFT$(UCASE$(zwsp$),4)
IF (q1$="RAD:" OR q1$="RAM:") AND zq<ii THEN
  LOCATE 10,10:PRINT "zu wenig Speicherplatz vorhanden"
  taste q
  GOTO haupt
END IF
fehler=0
ON ERROR GOTO fehlerausw
OPEN zwsp$+"comtext" AS 2 LEN=de(3)
ON ERROR GOTO 0
IF fehler=64 OR fehler=68 OR fehler=61 OR fehler=53 OR fehler=74 THEN
  CLOSE 2
  LOCATE 10,10:PRINT "Fehler beim Öffnen des Zwischenspeichers (Taste)"
  taste q
  GOTO haupt
END IF
FIELD 2,de(3) AS zwd$
q1$="":c$="":io=1
belegeram q
IF NOT(q) THEN
  LOCATE 10,10:PRINT "zu wenig Speicherplatz vorhanden"
  taste q
  CLOSE 2
  GOTO haupt
END IF
io=0
IF o=0 THEN FOR i=1 TO an:index=in(i)
IF o=0 AND ((dr(index)AND 1)=0) AND (au>0) THEN 10000
IF b4 AND z(zmax+1,index)=0 THEN 10000
IF NOT(b2) THEN
  q=0:FOR j=0 TO zmax-1
    q=q+z(j,index)
  NEXT j
  q=z(zmax,index)-q+z(zmax+1,index)
  IF q=0 THEN 10000
END IF
LOCATE 10,10:PRINT USING "\                            \";t$(index)
oeffne weg$+t$(index),1,satzl,0
FIELD 1,satzl AS d$
laenge=LOF(1)/satzl
b8=j(index)>-1:n1=0:n2=0:lj=-1:IF b8 THEN n1=-1
IF (io-1) MOD ii=0 AND io>1 THEN GOSUB 15000
IF c$<>"" THEN LSET zwd$=c$:PUT 2,io
io=io+1
c$=t$(index)+" "
FOR l=1 TO laenge
  GET 1,l:decodiere d$
  IF b3 OR dat(0)=0 THEN
    b14=dat(0)=0
    jahreszahl l,j,nr
    GOSUB 12000
    IF ASC(INKEY$+" ")=129 THEN
      LOCATE 21,10:PRINT "CR = Hauptmenü, F10 = weiter"
      q=0
      WHILE q<>13 AND q<>129 AND q<>138
        taste q
      WEND
      IF q=13 OR q=129 THEN 10110
    END IF
  END IF
NEXT l
10000
CLOSE 1
IF b5 THEN
  IF n1>0 THEN GOSUB 14400:GOSUB 14900
ELSEIF b7 THEN
  IF n1>0 THEN GOSUB 14400:GOSUB 14300:GOSUB 14900
END IF
IF o=0 THEN NEXT i:au=0
IF c$<>"" THEN LSET zwd$=c$:PUT 2,io
10021
CLS
LOCATE 1,36:PRINT "Ausdruck"
LOCATE 8,3:PRINT "Bitte den Drucker so einstellen, daß der Druckkopf am Blattangang steht."
LOCATE 9,3:PRINT "Dann Taste drücken."
taste q
IF q=129 THEN 10110
IF ersterDruck THEN
  OPEN "prt:" FOR OUTPUT AS 4
  PRINT #4,CHR$(7);
  CLOSE 4
  ersterDruck=false
END IF
OPEN de$(3) FOR OUTPUT AS 4
PRINT #4,de$(2);
CLOSE 4
OPEN "prt:" FOR OUTPUT AS 4
IF ig>0 THEN
  LOCATE 11,3:PRINT "Bitte die Diskette mit den Druckdaten einlegen + Taste"
  taste q
  oeffne comtext$,3,de(3),0
  FIELD 3,de(3) AS comt$
END IF
se=2*(((io-1)\ii+ig)\2)+1:REM Anzahl benutzter Seiten -1
FOR j=0 TO se\2
  FOR k=1 TO ii
    IF ASC(INKEY$+" ")=129 THEN 10050
    IF j<ig THEN
      GET 3,j*ii+k
      c$=comt$+de$(4)
    ELSEIF (j-ig)*ii+k<=io THEN
      GET 2,(j-ig)*ii+k
      c$=zwd$+de$(4)
    ELSE
      c$=le$+de$(4)
    END IF
    IF se-j<ig THEN
      GET 3,(se-j)*ii+k
      c$=c$+comt$
    ELSEIF (se-j-ig)*ii+k <=io THEN
      GET 2,(se-j-ig)*ii+k
      c$=c$+zwd$
    END IF
    PRINT #4,c$
  NEXT k
  CLOSE 4
  OPEN de$(3) FOR OUTPUT AS 4
  PRINT #4,de$(1);:PRINT #4,de$(1);
  CLOSE 4
  OPEN "prt:" FOR OUTPUT AS 4
NEXT j
10050
CLOSE 4:IF ig>0 THEN CLOSE 3
LOCATE 20,5:PRINT "CR = Ende, F10 = nochmal ausdrucken"
q=0
WHILE q<>13 AND q<>138 AND q<>129
  taste q
WEND
IF q=138 THEN 10021
10110
CLOSE 2:KILL zwsp$+"comtext":au=0
ON ERROR GOTO fehlerausw
IF ig>0 THEN KILL comtext$
ON ERROR GOTO 0
MENU 1,0,1:MENU 2,0,1:MENU 3,0,1:MENU 4,0,0,""
q1=0:GOTO haupt

SUB belegeram(q) STATIC
SHARED zwd$,de(),io,ii,fehler,true,false
LSET zwd$=SPACE$(de(3))
fehler=0:q=true
ON ERROR GOTO fehlerausw
FOR x=io TO io+ii-1
  PUT 2,x
IF fehler=61 THEN
  q=false
  GOTO be
END IF
NEXT x
be:
END SUB

12000
 IF b8 THEN b9= j<>lj :ELSE b9=false
 IF b9 THEN lj=j
 b10= n1=-1
 b11= n1=0
 IF b4 THEN
   b12=geszahl>1
 ELSEIF NOT(b2) THEN
   b12=geszahl=0
 ELSE
   b12=geszahl>0
 END IF
 b13=zust$(bestZust)=alterzust$
REM entscheidungstabelle
 b20=b8 IMP NOT(b9 OR b10)
 b21=b3 IMP b14
 b22=b8 AND b9
 b23=NOT(b3 OR b12)
 b24=NOT(b5 OR b6 OR b7)
 b25=b3 AND NOT(b12)AND b14
 b26=b10 OR(b9 AND b11)
 b27=b10 OR b11
 IF (b23 AND(((b24 OR b6)AND NOT(b22)) OR (((NOT(b8)AND b11)OR (b8 AND((NOT(b9)AND b11)OR b10)))AND((NOT(b4)AND(b5 OR b7))OR(b2 AND b5))))) OR (b3 AND NOT(b14)AND(((b6 OR NOT(b7))AND NOT(b22))OR (b7 AND (b8 IMP(b9 IMP b10))))) THEN
 ELSEIF b20 AND((NOT(b3) AND b24 AND b12)OR(b3 AND b14 AND(NOT(b12)AND(b6 OR(b7 AND b11)))OR b24)) THEN
   GOSUB 14200:q1$=q1$+",":GOSUB 14900 '2
 ELSEIF b6 AND b12 AND b20 AND b21 THEN
   GOSUB 14200:GOSUB 14300:GOSUB 14900 '17
 ELSEIF NOT(b11) AND b12 AND b20 AND((NOT(b3)AND b5)OR(b7 AND b13 AND b21)) THEN
   n2=nr '6
 ELSEIF b7 AND b12 AND b20 AND b21 AND NOT(b11 OR b13) THEN
   GOSUB 14400:q1$=q1$+":"+alterzust$+",":GOSUB 14900:n1=nr:alterzust$=zust$(bestZust) '12
 ELSEIF b11 AND NOT(b22)AND b7 AND b12 AND b21 THEN
   n1=nr:alterzust$=zust$(bestZust) '13
 ELSEIF b7 AND b20 AND NOT(b11)AND b23 THEN
   GOSUB 14400:q1$=q1$+":"+alterzust$+",":GOSUB 14900 '11
 ELSEIF b25 AND b7 AND b20 AND NOT(b11) THEN
   GOSUB 14400:q1$=q1$+":"+alterzust$+",":GOSUB 14900:GOSUB 14200:q1$=q1$+",":GOSUB 14900 '19
 ELSEIF NOT(b11 OR b22)AND b23 AND b5 THEN
   GOSUB 14400:q1$=q1$+",":GOSUB 14900 '5
 ELSEIF NOT(b3)AND b5 AND b11 AND b12 AND b20 THEN
   n1=nr '7
 ELSEIF b8 AND((b9 OR b10)AND(NOT(b3)AND b12 AND b24)OR(b3 AND b14 AND((b6 AND NOT(b12))OR(b24 AND b10 AND NOT(b9)))))OR(b3 AND b7 AND NOT(b12)AND b14 AND b26) THEN
   GOSUB 14600:GOSUB 14200:n1=0:q1$=q1$+",":GOSUB 14900 '3
 ELSEIF b22 AND((b23 AND(b24 OR((b5 OR b7)AND b11)OR b6))OR(b3 AND NOT(b14)AND(b6 OR(b7 IMP b11)))) THEN
   n1=-1 '4
 ELSEIF b6 AND b8 AND b12 AND b21 AND (b9 OR b10) THEN
   GOSUB 14600:GOSUB 14200:GOSUB 14300:GOSUB 14900:n1=0 '18
 ELSEIF b7 AND b8 AND b12 AND b26 AND b21 THEN
   GOSUB 14600:GOSUB 14900:n1=nr:alterzust$=zust$(bestZust) '16
 ELSEIF NOT(b3) AND b5 AND b8 AND b12 AND b26 THEN
   GOSUB 14600:n1=nr:GOSUB 14900 '8
 ELSEIF b3 AND b24 AND b22 AND b14 THEN
   GOSUB 14600:GOSUB 14200:q1$=q1$+",":GOSUB 14900:n1=0 '21
 ELSEIF b7 AND b22 AND b12 AND b21 AND NOT(b27) THEN
   GOSUB 14400:q1$=q1$+":"+alterzust$+",":GOSUB 14900:GOSUB 14600:GOSUB 14900:n1=nr:alterzust$=zust$(bestZust) '15
 ELSEIF b5 AND b22 AND b12 AND NOT(b3 OR b27) THEN
   GOSUB 14400:q1$=q1$+",":GOSUB 14900:GOSUB 14600:n1=nr:GOSUB 14900 '10
 ELSEIF b7 AND b22 AND NOT(b27) AND(b23 OR NOT(b21)) THEN
   GOSUB 14400:q1$=q1$+":"+alterzust$+",":GOSUB 14900:n1=-1 '14
 ELSEIF b5 AND b22 AND NOT(b27) AND b23 THEN
   GOSUB 14400:q1$=q1$+",":GOSUB 14900:n1=-1 '9
 ELSEIF b25 AND b7 AND b22 AND NOT(b27) THEN
   GOSUB 14400:q1$=q1$+":"+alterzust$+",":GOSUB 14900:GOSUB 14600:GOSUB 14200:q1$=q1$+",":GOSUB 14900 '20
 ELSE
   PRINT  "Fehler in Wertetabelle":STOP
 END IF
RETURN

REM aktuelle nr schreiben
14200
 IF (b2 IMP b3)AND NOT(b12) THEN
   q1$=q1$+nv1$+RIGHT$(STR$(nr),LEN(STR$(nr))-1)+nv2$
 ELSE
   q1$=q1$+RIGHT$(STR$(nr),LEN(STR$(nr))-1)
 END IF
RETURN
REM zust schreiben
14300
 IF NOT b4 THEN
   IF b6 THEN q1$=q1$+":"+zust$(bestZust) :ELSE q1$=q1$+":"+alterzust$
 ELSE
   q1$=q1$+"("
   FOR zu=1 TO zmax
     IF dat(zu)>0 THEN q1$=q1$+zust$(zu-1)+","
   NEXT zu
   q1$=LEFT$(q1$,LEN(q1$)-1)+")"
 END IF
 q1$=q1$+","
RETURN

REM n1 bis n2 schreiben
14400
 IF n2=0 THEN
   q1$=q1$+RIGHT$(STR$(n1),LEN(STR$(n1))-1)
 ELSE
   q1$=q1$+RIGHT$(STR$(n1),LEN(STR$(n1))-1)+"-"+RIGHT$(STR$(n2),LEN(STR$(n2))-1)
 END IF
n1=0:n2=0:RETURN

REM jahrgang schreiben
14600
 q1$=q1$+ja1$+RIGHT$(STR$(j),LEN(STR$(j))-1)+ja2$:lj=j:RETURN

REM q1 nach ram uebertragen
14900
 IF LEN(c$+q1$)>de(3) AND ((io-1) MOD ii)=0 AND io>1 THEN GOSUB 15000
 IF LEN(c$+q1$)> de(3) THEN
   LSET zwd$=c$:PUT 2,io
   io=io+1
   c$=q1$
 ELSE
   c$=c$+q1$
 END IF
q1$="":RETURN

15000
 zq=((FRE(-1)-20000)\(ii*(de(3)+2)))*ii
 q=true
 IF zq>=ii THEN CALL belegeram(q)
 IF zq<ii OR NOT(q) THEN
   CLOSE 1
   CLS
   IF ig>0 THEN
15015
     q1=1:oeffne comtext$,3,de(3),q1
     IF q1=1 THEN
       LOCATE 5,5:PRINT "Bitte die Diskette mit den Druckdaten einlegen + Taste"
       taste q
       IF q=129 THEN RETURN 10110
       GOTO 15015
     END IF
   ELSE
     LOCATE 5,5:PRINT "Die Daten müssen jetzt zwischengespeichert werden."
     LOCATE 7,5:PRINT "Bitte geben Sie einen Pfad ein (nicht RAM:) :"
15040
     LOCATE 9,5:comtext$="df0:":lies comtext$,30
     IF ASC(comtext$+" ")=129 THEN RETURN 10110
     IF UCASE$(LEFT$(comtext$,4))="RAM:" OR UCASE$(LEFT$(comtext$,4))="RAD:" THEN 15040
     IF RIGHT$(comtext$,1)<>":"AND RIGHT$(comtext$,1) <>"/" THEN comtext$=comtext$+"/"
     comtext$=comtext$+"comictext"
     fehler=0
     ON ERROR GOTO fehlerausw
     OPEN comtext$ AS 3 LEN=de(3)
     ON ERROR GOTO 0
     IF fehler>0 THEN LOCATE 20,10:PRINT "ungültiger Name":GOTO 15040
   END IF
   FIELD 3,de(3) AS comt$
   q=ig*ii
   FOR k=1 TO io-1
     GET 2,k:LSET comt$=zwd$:PUT 3,q+k
   NEXT k:CLOSE 3
   ig=ig+io\ii:io=1
   CLS
15400
   IF q1=1 THEN
     LOCATE 5,5:PRINT "Bitte jetzt die Diskette einlegen, bei der unterbrochen wurde."
     LOCATE 7,5:PRINT "Anschschließend eine Taste drücken:"
     taste q
     IF q=129 THEN RETURN 10110
     oeffne weg$+t$(index),1,satzl,0
   ELSE
     q1=1
     oeffne weg$+t$(index),1,satzl,q1
     IF q1=1 THEN 15400
   END IF
   FIELD 1,satzl AS d$
   CLS:LOCATE 10,10:PRINT t$(index)
 END IF
RETURN

dateiloeschen:
GOSUB 4650
LOCATE 1,28:PRINT " D a t e i   l ö s c h e n "
LOCATE 3,3:PRINT "Achtung !  Es werden sämtliche Daten von"
LOCATE 4,3:PRINT t$(index)" gelöscht."
LOCATE 5,3:PRINT "Bitte bestätigen Sie das Löschen mit Cr,"
LOCATE 6,3:PRINT "oder brechen Sie ab mit F10"
q=0
WHILE q<>13 AND q<>138 AND q<>129
  taste q
WEND
IF q=138 OR q=129 THEN haupt
CLS
oeffne weg$+t$(index),1,satzl,0
CLOSE 1:KILL weg$+t$(index):va=1
IF index<an THEN
  oeffne Pfad$+"Titel",1,34,0
  FIELD 1,1 AS laenge$,30 AS d$,1 AS jahr$,2 AS mnr$
  t$(index)=t$(an):j(index)=j(an):maxnr(index)=maxnr(an):dr(index)=dr(an)OR 4
  LSET laenge$=CHR$(LEN(t$(an)))
  LSET d$=t$(an)
  IF j(an)<0 THEN LSET jahr$=CHR$(100) :ELSE LSET jahr$=CHR$(j(an))
  mnr$=MKI$(maxnr(an))
  PUT 1,index
  CLOSE 1
  dr(0)=dr(0)OR 20
  FOR j=1 TO an:IF in(j)<>an THEN NEXT j
  in(j) =index
  FOR j=0 TO zmax+1
    z(j,index)=z(j,an)
  NEXT j
END IF
FOR j=i TO an-1
  in(j)=in(j+1)
NEXT j
an=an-1
aa=aa-1
va=1
IF an=0 THEN
  MENU 1,1,0:MENU 1,3,0:MENU 1,4,0:MENU 1,5,0
  MENU 2,0,0
  MENU 3,1,0
  MENU 3,3,0
END IF
GOTO haupt
REM -----
16000
CLS
LOCATE 5,5:PRINT "Die nötigen Dateien wurden nicht gefunden."
LOCATE 7,5:PRINT "1. Daten rekonstruieren"
LOCATE 9,5:PRINT "2. Programm beenden"
LOCATE 11,5:PRINT "3. Pfad wechseln"
LOCATE 13,5:PRINT "(Die notwendigen Dateien können mit dem Programm Installation erzeugt"
LOCATE 14,5:PRINT " werden.)"
q=0
WHILE q<1 OR q>3
  taste q
  q=q-ASC("0")
WEND
IF q=2 THEN END
IF q=1 THEN datenrek :ELSE GOTO pfadwechsel
REM binäres suchen,i ist Nr. des gefundenen oder -1 falls nicht gef.
suche:
16500
 u=1:o=an:q1$=q$:umlaut q1$
 WHILE u<=o
   i=(u+o)\2
   q2$=t$(in(i)):umlaut q2$
   IF q1$<q2$ THEN
     o=i-1
   ELSEIF q1$>q2$ THEN
     u=i+1
   ELSE
     u=o+1
   END IF
 WEND
 IF UCASE$(q$)<>UCASE$(t$(in(i))) THEN i=-1
RETURN
druckereinst:
CLS:LOCATE 1,30:PRINT "Druckereinstellung"
LOCATE 3,5:PRINT "Steuerbefehl für:"
LOCATE 5,4:PRINT "Normale Schrift :"
LOCATE 7,4:PRINT "Zeilenvorschub  :"
LOCATE 9,4:PRINT "Kleine Schrift an :"
LOCATE 12,5:PRINT "Anzahl der "
LOCATE 14,4:PRINT "Zeilen pro Blatt normal:"
LOCATE 16,4:PRINT "       bei Kleinschrift:"
LOCATE 18,4:PRINT "Zeichen pro Zeile bei Kleinschrift :"
LOCATE 20,4:PRINT "Schnittstelle (SER:/PAR:) :"
LOCATE 23,3:PRINT "Einstellung mit Cr übernehmen oder mit F10 abändern";
FOR j=0 TO 2
  LOCATE 5+2*j,23
  FOR k=1 TO LEN(de$(j))
    PRINT ASC(MID$(de$(j),k,1));
  NEXT k
NEXT j
LOCATE 14,29:PRINT de(0)
LOCATE 16,29:PRINT de(1)
LOCATE 18,42:PRINT de(2)
LOCATE 20,32:PRINT de$(3)
q=0
WHILE q<>13 AND q<>138 AND q<>129
  taste q
WEND
IF q=13 OR q=129 THEN haupt
FOR j=0 TO 2
  q$=""
  FOR k=1 TO LEN(de$(j)):q$=q$+STR$(ASC(MID$(de$(j),k,1))):NEXT k
  de$(j)=""
  LOCATE 5+2*j,23:PRINT SPACE$(55);
16905
  LOCATE 5+2*j,23:lies q$,55: IF q$="" THEN 16905
  q1$="":ii=1
  FOR k=1 TO LEN(q$)
    q2$=MID$(q$,k,1)
    IF (q2$<"0"OR q2$>"9") AND q2$<>" " THEN 16905
    IF ii<>1 OR q2$<>" " THEN
      q1$=q1$+q2$:ii=0
      IF q2$=" " OR k=LEN(q$) THEN
        IF LEN(q1$)>5 THEN 16905
        IF VAL (q1$)>255 THEN 16905
        de$(j)=de$(j)+CHR$(VAL(q1$)):q1$="":ii=1
      END IF
    END IF
  NEXT k
NEXT j
q$=STR$(de(0)):q=0
long&=0
WHILE long&<10 OR long&>500
  LOCATE 14,29 : lies q$,6
  long&=VAL(q$)
WEND
de(0)=long&:q$=STR$(de(1)):long&=0
WHILE long&<10 OR long&>500
  LOCATE 16,29 :lies q$,6
  long&=VAL(q$)
WEND
de(1)=long&:q$=STR$(de(2)):long&=0
WHILE long&<10 OR long&>500
  LOCATE 18,42 :lies q$,6
  long&=VAL(q$)
WEND
de(2)=long&
q$=""
WHILE q$<>"PAR:" AND q$<>"SER:"
  q$=de$(3)
  LOCATE 20,32:lies q$,4
  q$=UCASE$(q$)
WEND
de$(3)=q$
oeffne Pfad$+"Drucker",1,1,0
CLOSE 1
OPEN Pfad$+"Drucker"FOR OUTPUT AS 1
PRINT #1,komplpfad$
PRINT #1,lib$
PRINT #1,zwsp$
FOR k=0 TO 3
  PRINT #1,CHR$(34)+de$(k)+CHR$(34)
NEXT k
FOR k=0 TO 2
  PRINT #1,MKI$(de(k));
NEXT k
CLOSE 1:de(3)=(de(2)\2)-2
de$(4)="    "+SPACE$(de(2) MOD 2)
GOTO haupt

SUB oeffne (datname$,nummer,l,rm) STATIC
SHARED fehler
ON ERROR GOTO fehlerausw
op:fehler=0
OPEN datname$ FOR INPUT AS nummer
CLOSE nummer
  IF fehler=74 AND rm=0 THEN op
  IF fehler=74 THEN op1
  IF fehler=53 AND rm=0 THEN CALL wechslepfad:GOTO op
  IF fehler<>53 OR rm<>1 THEN rm=0:OPEN datname$ AS nummer LEN=l
op1:ON ERROR GOTO 0
END SUB
fehlerausw:
  fehler=ERR
RESUME NEXT

pfadwechsel:
CLS:fehler=0
wechslepfad
ON ERROR GOTO 0
IF mq=0 THEN RETURN :ELSE GOTO haupt
SUB wechslepfad STATIC
SHARED komplpfad$,fehler
ON ERROR GOTO fehlerausw
pf1:WINDOW 2,"Bitte den kompletten Pfad eingeben:",(20,20)-(550,70),2
pf2:LOCATE 1,1:lies komplpfad$,30
  IF INSTR(komplpfad$,":")=0 THEN pf1
  CHDIR komplpfad$
  IF fehler=53 OR fehler=74 THEN fehler=0:WINDOW 2:GOTO pf2
  IF RIGHT$(komplpfad$,1)<>":" AND RIGHT$(komplpfad$,1)<>"/" THEN komplpfad$=komplpfad$+"/"
  WINDOW CLOSE 2
END SUB

SUB taste (t) STATIC
SHARED men0,men1,mausx,mausy
mausx=-1
mausy=-1
rq$=""
tas:
 SLEEP
 rq$=INKEY$+CHR$(0)
 men0=MENU(0)
 men1=MENU(1)
 q=MOUSE(0)
 IF q>0 THEN
   mausx=MOUSE(1)
   mausy=MOUSE(2)
 END IF
 t=ASC(rq$)
IF men0=0 AND t=0 AND mausx=-1 THEN tas
END SUB

SUB titelleiste (q) STATIC
SHARED j(),index,zmax
IF q=1 THEN
  LOCATE 1,1:PRINT "Titel:"
  LOCATE 1,31:IF j(index)>-1 THEN PRINT "Jahr ";
  PRINT "  Nr:";
  FOR j=0 TO zmax-1:PRINT  USING "###";j;:NEXT:PRINT " Gesamt"
ELSEIF q=2 THEN
  LOCATE 1,1:PRINT "Titel:"
  IF j(index)>-1 THEN LOCATE 1,32:PRINT "Jahr";
  LOCATE 1,38:PRINT "Nummer";
ELSEIF q=3 THEN
  PRINT #4,"Titel:                        ";
  IF j(index)>-1 THEN PRINT #4,"Jahr"; :ELSE PRINT #4,"    ";
  PRINT #4,"   Nr:";
  FOR j=0 TO zmax-1:PRINT #4,USING "###";j;:NEXT:PRINT #4," Gesamt"
ELSEIF q=4 THEN
  PRINT #4,"Titel:                         ";
  IF j(index)>-1 THEN PRINT #4,"Jahr"; :ELSE PRINT #4,"    ";
  PRINT #4,"   Nummer"
END IF
END SUB

SUB jahreszahl (zahl,jahr,nummer) STATIC
SHARED index,j(),maxnr()
 IF j(index)=-1 THEN
   nummer=zahl:jahr=-1
 ELSE
   jahr=(zahl-1)\maxnr(index)+j(index)
   nummer=((zahl-1)MOD maxnr(index))+1
   IF jahr>99 THEN jahr=jahr-100
 END IF
END SUB

SUB lies (n$,ml%) STATIC
nn$=n$:nurCr=1
y=CSRLIN:x=POS(0):xakt=1
schr:LOCATE y,x:PRINT LEFT$(nn$,xakt-1);
     COLOR 2
     PRINT MID$(nn$,xakt,1);
     COLOR 1
     IF xakt<LEN(nn$) THEN PRINT RIGHT$(nn$,LEN(nn$)-xakt);
     PRINT l$;:l$=""
ls: SLEEP:q$=INKEY$:IF q$="" THEN ls
q=ASC(q$)
IF q=13 THEN le
IF q=29 OR q=28 THEN ls
IF q=31 AND xakt>1 THEN xakt=xakt-1
IF q=30 AND xakt<=LEN(nn$) THEN xakt=xakt+1
IF q=30 OR q=31 THEN schr
nurCr=0
IF q=8 AND  nn$<>"" AND xakt>1 THEN nn$=LEFT$(nn$,xakt-2)+RIGHT$(nn$,LEN(nn$)-xakt+1):xakt=xakt-1:l$=" ":GOTO schr
IF q=127 AND nn$<>"" AND xakt<= LEN(nn$) THEN nn$=LEFT$(nn$,xakt-1)+RIGHT$(nn$,LEN(nn$)-xakt):l$=" ":GOTO schr
IF q=8 OR q=127 GOTO ls
IF LEN(nn$)=ml% THEN ls
nn$=LEFT$(nn$,xakt-1)+q$+RIGHT$(nn$,LEN(nn$)-xakt+1)
xakt=xakt+1
GOTO schr
le:
IF nurCr=0 THEN n$=LEFT$(nn$,xakt-1):LOCATE y,x+xakt-1:PRINT STRING$(LEN(nn$)-xakt+1,32)
END SUB

SUB schreibezustaende STATIC
SHARED zmax,bestZust,dat()
  LOCATE 12,14:PRINT  "Zustand    ";
  FOR j=0 TO zmax-1:PRINT  USING"###";j;:NEXT
  LOCATE 14,14:PRINT  "Anzahl     ";STRING$(bestZust*3,32);
  FOR j=bestZust+1 TO zmax
    IF dat(j)=0 THEN PRINT "   "; :ELSE PRINT  USING"###";dat(j);
  NEXT j
END SUB

SUB decodiere(t$) STATIC
SHARED dec(),geszahl,dat(),zmax,bestZust
IF t$<>"" THEN
ass&=0
Adr&=0
gadr&=0
dadr&=0
bzadr&=0
Adr&=SADD(t$)
gadr&=VARPTR(geszahl)
dadr&=VARPTR(dat(0))
bzadr&=VARPTR(bestZust)
ass&=VARPTR(dec(0))
CALL ass&(Adr&,gadr&,dadr&,zmax,bzadr&)
END IF
END SUB

SUB codiere(t$) STATIC
SHARED cod(),dat(),zmax,satzl
t$=STRING$(satzl,0)
ass&=0
Adr&=0
dadr&=0
Adr&=SADD(t$)
dadr&=VARPTR(dat(0))
ass&=VARPTR(cod(0))
CALL ass&(Adr&,dadr&,zmax)
END SUB

SUB umlaut(t$) STATIC
SHARED um()
u$=t$+""
IF u$<>"" THEN
  ass&=0
  Adr&=0
  laenge&=0
  Adr&=SADD(u$)
  laenge&=LEN(u$)
  ass&=VARPTR(um(0))
  CALL ass&(Adr&,laenge&)
  t$=u$
END IF
END SUB
REM umlaut
DATA 0000,0000,0000,002C,0000,03E9,0000,002C
DATA 48E7,C080,206F,0010,202F,0014,5380,1230
DATA 0800,0C01,FFE4,6600,000C,11BC,0061,0800
DATA 6000,0084,0C01,FFC4,6600,000C,11BC,0061
DATA 0800,6000,0072,0C01,FFF6,6600,000C,11BC
DATA 006F,0800,6000,0060,0C01,FFD6,6600,000C
DATA 11BC,006F,0800,6000,004E,0C01,FFFC,6600
DATA 000C,11BC,0075,0800,6000,003C,0C01,FFDC
DATA 6600,000C,11BC,0075,0800,6000,002A,0C01
DATA FFDF,6600,000C,11BC,0073,0800,6000,0018
DATA 0C01,0028,6300,0010,0C01,005A,6200,0008
DATA 08F0,0005,0800,51C8,FF66,4CDF,0103,4E75
DATA 0000,03F2

REM cod
DATA 0000,0000,0000,0011,0000,03E9,0000,0011
DATA 48E7,F0C0,206F,001C,226F,0020,222F,0024
DATA 5341,E249,6500,0006,343C,0001,3019,E988
DATA 3619,0243,000F,D003,10C0,51C9,FFF0,0802
DATA 0000,6600,0008,3011,E948,1080,4CDF,030F
DATA 4E75,4E71,0000,03F2
REM decode
DATA 0000,0000,0000,0025,0000,03E9,0000,0025
DATA 48E7,F8F0,206F,0028,226F,002C,246F,0030
DATA 222F,0034,266F,0038,1010,0200,00F0,6600
DATA 0070,78FF,7400,5341,E249,6500,0006,343C
DATA 0001,7600,1018,E898,0240,000F,34C0,0C43
DATA 0000,6600,000C,0C00,0000,6600,0004,5284
DATA D640,E998,0240,000F,34C0,0C43,0000,6600
DATA 000C,0C40,0000,6600,0004,5284,D640,51C9
DATA FFC4,0802,0000,6600,000E,1010,E808,0240
DATA 000F,3480,D640,3283,3684,4CDF,0F1F,4E75
DATA 3480,60F6,0000,03F2

fehlerausw2:
CALL xClose&(fhandle&)
LIBRARY CLOSE
CLOSE 1
LOCATE 21,10:PRINT "Fehler beim Sichern"
taste q
RESUME nachhaupt

datensich:
CLS
 LINE (26,28)-(182,44),1,b
 LOCATE 5,5:PRINT "1. volle Sicherung"
 LINE (26,52)-(198,68),1,b
 LOCATE 8,5:PRINT "2. nur Veränderungen"
 io=0
 WHILE io<1 OR io>2
   taste q
   IF q=129 THEN haupt
   IF mausx>25 THEN
     IF mausx<183 AND mausy>27 AND mausy<45 THEN io=1
     IF mausx<199 AND mausy>51 AND mausy<69 THEN io=2
   ELSE
     io=q-ASC("0")
   END IF
 WEND
GOSUB 8010
LOCATE 5,5:PRINT "Wohin sollen die Daten gesichert werden ?"
q1$=""
WHILE q1$=""
  LOCATE 6,5:PRINT "Kompletter Pfad: ";:INPUT q1$
WEND
IF ASC(q1$)=129 THEN haupt
q$=komplpfad$
IF RIGHT$(q1$,1)="/" THEN q1$=LEFT$(q1$,LEN(q1$)-1)
GOSUB dat1
IF dr(0)>0 THEN
  oeffne Pfad$+"Voreinstellung",1,1,0:PRINT "Voreinstellung"
  FIELD 1,1 AS d$
  FOR i=0 TO an
    IF (dr(i)AND 6)>0 THEN LSET d$=CHR$(dr(i)AND 1):PUT 1,i+1:dr(i)=dr(i)AND 251
  NEXT i:CLOSE 1
  dr(0)=dr(0)OR 32
END IF
GOSUB dat2
17500
GOTO haupt

dat1:
GOSUB openlib
ON ERROR GOTO fehlerausw2
fhandle& = xOpen&(SADD("con:20/10/600/130/"+CHR$(0)),1005)
IF fhandle& = 0 THEN
  PRINT:PRINT  "Fehler im DOS"
  taste q
  CALL xClose&(fhandle&)
  LIBRARY CLOSE
  ON ERROR GOTO 0
  IF an=0 THEN RETURN 16000 :ELSE RETURN haupt
END IF
x=Execute&(SADD("makedir "+q1$+CHR$(0)), 0,fhandle&)
d1$="comp":d2$="comdat"
IF INSTR("/:",RIGHT$(q1$,1))=0 THEN q1$=q1$+"/"
x=Execute&(SADD("makedir "+q1$+d1$+CHR$(0)), 0,fhandle&)
x=Execute&(SADD("makedir "+q1$+d2$+CHR$(0)), 0,fhandle&)
d1$=d1$+"/":d2$=d2$+"/"
IF (dr(0)AND 2)>0 OR io=1 THEN
  GOSUB dat3
  x=Execute&(SADD("copy "+q$+d1$+"Index "+q1$+d1$+"Index"+CHR$(0)), 0,fhandle&)
END IF
IF (dr(0)AND 8)>0 OR io=1 THEN
  GOSUB dat3
  x=Execute&(SADD("copy "+q$+d1$+"Zahlen "+q1$+d1$+"Zahlen"+CHR$(0)), 0,fhandle&)
END IF
IF (dr(0)AND 16)>0 OR io=1 THEN
  GOSUB dat3
  x=Execute&(SADD("copy "+q$+d1$+"Titel "+q1$+d1$+"Titel"+CHR$(0)), 0,fhandle&)
END IF
IF (dr(0)AND 64)>0 OR io=1 THEN
  GOSUB dat3
  x=Execute&(SADD("copy "+q$+d1$+"Druckart "+q1$+d1$+"Druckart"+CHR$(0)), 0,fhandle&)
END IF
IF (dr(0)AND 128)>0 OR io=1 THEN
  GOSUB dat3
  x=Execute&(SADD("copy "+q$+d1$+"Drucker "+q1$+d1$+"Drucker"+CHR$(0)), 0,fhandle&)
END IF
ON ERROR GOTO 0
GOSUB dat3
FOR j=1 TO an
  IF io=1 OR (dr(j)AND 6)>0 THEN
    IF (j MOD 400)=0 THEN FOR x=1 TO 2000:NEXT x
    LOCATE 20,5:PRINT USING "\                            \";t$(j)
    qq$=q$+d2$+t$(j)
    oeffne qq$,1,1,0:CLOSE 1
    x=Execute&(SADD("copy "+CHR$(34)+qq$+CHR$(34)+" "+CHR$(34)+q1$+d2$+t$(j)+CHR$(34)+CHR$(0)), 0,fhandle&)
    dr(j)=dr(j) AND 1
  END IF
NEXT j
RETURN
dat2:
IF (dr(0)AND 32)>0 OR io=1 THEN
  x=Execute&(SADD("copy "+q$+d1$+"Voreinstellung "+q1$+d1$+"Voreinstellung"+CHR$(0)), 0,fhandle&)
END IF
dr(0)=0
CALL xClose&(fhandle&)
LIBRARY CLOSE
RETURN
dat3:
LOCATE 21,5:PRINT "Bitte Diskette "+q$+" einlegen + Taste"
taste q
LOCATE 21,5:PRINT SPACE$(70)
RETURN

datenrek:
CLS
IF an>0 THEN
  LOCATE 5,5:PRINT "Achtung ! Bei der der Rekonstruktion der Daten werden aktuellen"
  LOCATE 6,5:PRINT "Werte gelöscht, und mit denen der letzten Sicherung ersetzt."
  LOCATE 7,5:PRINT "(d.h. die Rekonstruktion sollte nur dann ausgeführt werden, wenn"
  LOCATE 8,5:PRINT "sie wirklich notwendig ist, da sonst Daten verloren gehen.)"
  LOCATE 10,5:PRINT "Cr: weiter      F10: zurück zum Hauptmenü"
  q=0
  WHILE q<>13 AND q<>138 AND q<>129
    taste q
  WEND
  IF q=138 OR q=129 THEN haupt
  CLS
END IF
LOCATE 3,5:PRINT "Datenrekonstruktion"
LOCATE 5,5:PRINT "Woher sollen die Daten gelesen werden (Sicherungsdiskette) ?"
q$=""
WHILE q$=""
  LOCATE 7,5:PRINT "Pfad: ";:INPUT q$
WEND
IF ASC(q$)=129 THEN haupt
IF INSTR("/:",RIGHT$(q$,1))=0 THEN q$=q$+"/"
q=1
oeffne q$+"comp/Zahlen",1,1,q
CLOSE 1
  IF q=1 THEN
    LOCATE 20,5:PRINT "Falscher Pfad (Taste)":taste q
    IF an=0 THEN 16000 :ELSE GOTO haupt
  END IF
oeffne Pfad$+"Drucker",1,1,0
CLOSE 1
OPEN Pfad$+"Drucker" FOR INPUT AS 1
 INPUT#1,komplpfad$
 INPUT#1,lib$
CLOSE 1
  q1$=komplpfad$
  IF RIGHT$(q1$,1)="/" THEN q1$=LEFT$(q1$,LEN(q1$)-1)
  io=1
  GOSUB dat1
  GOSUB dat2
CLEAR ,100000
GOTO anfang

openlib:
ON ERROR GOTO fehlerausw
q2$=lib$
opl1:
fehler=0
LIBRARY q2$+"dos.library"
IF fehler=53 THEN
  IF q2$=lib$ THEN q2$="LIBS:":GOTO opl1
  LOCATE 11,5:PRINT "Bitte den Pfad zur DOS Lib eingeben. "
  LOCATE 12,5:INPUT q2$
  GOTO opl1
END IF
ON ERROR GOTO 0
RETURN

initialisierung:
geszahl=0:bestZust=0:REM wichtig fuer dec
dg=0:men0=0:men1=0
n$="":nn$="":ver=0
xakt=0:t$="":index=0:mausx=-1:mausy=-1
l$="":laenge=0:o=0:j$="":nr=0:nr$=""
z=0:z$="":an$="":l=0
wahl=0:gz=0:stw=0:io=0:az$="":zust=0:anzahl=0
gesamt=0:fehlend=0:doppelt=0:maximum=0:breite=0:hoehe=0
x=0:y=0:tt$="":maxnum=0:jj=0:nn=0:ll=0:aj=0:sn=0:ok=0
zz=0:vanz=0:q1=0:se=0:ii=0:ig=0:b2=0:b3=0:b4=0:b5=0:b6=0:b7=0
b8=0:b9=0:b10=0:b11=0:b12=0:b13=0:b14=0:b20=0:b21=0:b22=0:b23=0
b24=0:b25=0:b26=0:b27=0
fhandle&=0
RETURN

nachhaupt:
ON ERROR GOTO 0
GOTO haupt